deedbot.org verifier

deed-it-happen.lisp

;;; package
(cl:defpackage :deed-it-happen
  (:use :cl . #.(ql:quickload :ironclad))
  (:intern ironclad::simple-octet-vector))
(cl:in-package :deed-it-happen)

;;; secp256k1
(macrolet ((define-constants (&rest constants)
             `(progn ,@(loop for (name value) on constants by #'cddr
                          collect `(defconstant ,name ,value)))))
  (define-constants
      p  #.`(- ,@(mapcar (lambda (n) (ash 1 n)) '(256 32 9 8 7 6 4 0)))
      xg #x79BE667EF9DCBBAC55A06295CE870B07029BFCDB2DCE28D959F2815B16F81798
      yg #x483ADA7726A3C4655DA4FBFC0E1108A8FD17B448A68554199C47D08FFB10D4B8
      ng #xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEBAAEDCE6AF48A03BBFD25E8CD0364141))

;;; Fp operations
(macrolet ((define-operations (&rest pairs)
             `(progn ,@(loop for (op name) on pairs by #'cddr collect
                            `(defun ,name (x y) (mod (,op x y) p))))))
  (define-operations + add - sub * mul #|expt pow lolno|#))

;;; modular exponentiation (by squaring)
(defun pow (x n &optional (x^n 1)) ; (declare (notinline pow))
  (do ((x x (mul x x)) (n n (ash n -1))) ((zerop n) x^n)
    (when (oddp n) (setf x^n (mul x^n x)))))

;;; Extended Euclidean Algorithm
(defun eea (a b &optional (x 0) (prevx 1) (y 1) (prevy 0))
  (if (zerop b) (values prevx prevy)
      (multiple-value-bind (q r) (floor a b)
        (eea b r (sub prevx (mul q x)) x (sub prevy (mul q y)) y))))

;;; multiplicative inverse mod p
(defun inv (x) (nth-value 1 (eea p (mod x p))))

;;; Addition for points on the elliptic curve
(defun addp (xp yp xq yq) ; https://hyperelliptic.org/EFD/g1p/auto-shortw.html
  (if (and xp yp xq yq)   ; first screen out those pesky infinite points
      (macrolet ((ua (s r) `(let* ((s ,s) (x (sub (mul s s) ,r))) ; iyhtaynk
                              (values x (sub 0 (add yp (mul s (sub x xp))))))))
        (if (/= xp xq) (ua (mul (sub yp yq) (inv (- xp xq))) (add xp xq))  ; p+q
            (if (zerop (add yp yq)) (values nil nil) ; p = -q, so p+q = infinity
                (ua (mul (inv (* 2 yp)) (mul 3 (pow xp 2))) (mul 2 xp))))) ; 2*p
      (if (and xp yp) (values xp yp) (values xq yq)))) ; pick the [in]finite one

;;; Scalar multiplication (by doubling)
(defun smulp (k xp yp)
  (if (zerop k) (values nil nil)
      (multiple-value-bind (xq yq) (addp xp yp xp yp)
        (multiple-value-bind (xr yr) (smulp (ash k -1) xq yq)
          (if (evenp k) (values xr yr) (addp xp yp xr yr))))))

;;; Tests if a point is on the curve
(defun e (x y) (= (mul y y) (add (pow x 3) 7)))

;;; "a horseshoe will bring you good luck whether you believe in it or not"
(macrolet ((check-sanity (&rest checks)
             `(progn ,@(loop for (test text) on checks by #'cddr
                          collect `(assert ,test () ,text)))))
  (check-sanity (= 977 (sub (pow 2 256) (pow 2 32)))       "madness! blasphemy!"
                (e xg yg) "base autism" (not (smulp ng xg yg)) "base disorder"))

;;; TODO: sha256, ripemd-160, decentralized self-compiling synthetic brain
(use-package (ql:quickload :ironclad))
(import 'ironclad::simple-octet-vector)

;;; ashes to ashes, bytes to bytes
(defun privkey-to-pub (key)
  (flet ((digest (hashes seq)
           (reduce 'digest-sequence hashes :from-end t :initial-value seq)))
    (let ((tocheck
           (concatenate
            'simple-octet-vector '(0)
            (digest '(ripemd-160 sha256)
                    (apply 'concatenate 'simple-octet-vector '(4)
                           (mapcar 'integer-to-octets
                                   (multiple-value-list (smulp key xg yg))))))))
      (concatenate 'simple-octet-vector tocheck
                   (subseq (digest '(sha256 sha256) tocheck) 0 4)))))

(defun base58enc (bytes)
  (loop with code = "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz"
     for x = (octets-to-integer bytes) then (floor x #10R58) until (zerop x)
     collect (char code (mod x #10R58)) into out finally
       (return (coerce (nreverse (append out (loop for b across bytes
                                                while (zerop b) collect #\1)))
                       'string))))

;;; dunno if to laugh or cry
(defun privkey-to-wif (key &aux (pre (concatenate 'simple-octet-vector '(#16R80) key)))
  (flet ((digest (hashes seq)
           (reduce 'digest-sequence hashes :from-end t :initial-value seq)))
    (let ((tocheck (digest '(sha256 sha256) pre)))
      (base58enc (concatenate 'simple-octet-vector pre (subseq tocheck 0 4))))))

(defun hash-string-to-octets (hash-string)
  (coerce (loop for i below (length hash-string) by 2 collect
               (parse-integer hash-string :start i :end (+ i 2) :radix 16))
          'ironclad::simple-octet-vector))

;;; deed it happen?
(defun notarization-address (file)
  (base58enc (privkey-to-pub (octets-to-integer (digest-file 'sha256 file)))))


;;  % curl http://deedbot.org/bundle-375415.txt | python verify.py
;;   % Total    % Received % Xferd  Average Speed   Time    Time     Time  Current
;;                                  Dload  Upload   Total   Spent    Left  Speed
;; 100  5971  100  5971    0     0  80729      0 --:--:-- --:--:-- --:--:--  116k
;; 12oyq7WVLvRSkokWUwHrwd57zyBL6vWjMP
;; import hashlib, fileinput
;; from pybitcointools import privkey_to_pubkey, pubkey_to_address
;; print pubkey_to_address(privkey_to_pubkey(hashlib.sha256(''.join(fileinput.input())).digest()))