;;; lam-par-lisp-poc by phf

(defun randomness (size)
  (with-open-file (input #p"/dev/random" :element-type '(unsigned-byte 8))
    (let ((arr (make-array size :element-type (stream-element-type input))))
      (read-sequence arr input)
      arr)))

(defun hexify (bytearray)
  (let ((*print-base* 16))
    (format nil "~{~2,'0x~}" (coerce bytearray 'list))))

(defun mkpriv (payloadbits strengthbits)
  (loop for i from 1 upto payloadbits
        collect (cons (randomness (/ strengthbits 8))
                      (randomness (/ strengthbits 8)))))

(defun priv->pub (hashthunk privkey)
  (loop for (a . b) in privkey
        collect (cons (funcall hashthunk a)
                      (funcall hashthunk b))))

(defun priv->pub-sha256 (privkey)
  (priv->pub (lambda (a) (ironclad:digest-sequence :sha256 a))
            privkey))

;;Great boobies honeybun, my lower intestine is full of spam
(defun encode (privkey payload)
  (assert (= (length privkey) (* 8 (length payload))))
  (labels ((b (n)
             (multiple-value-bind (n b) (truncate n 8)
               (ldb (byte 1 b) (elt payload n)))))
    (loop for (a . b) in privkey
          for n from 0
          collect (if (zerop (b n))
                      a
                    b))))

(defun decode (hashthunk pubkey encoded)
  (let ((result (make-array (/ (length pubkey) 8)
                            :element-type '(unsigned-byte 8)
                            :initial-element 0)))
    (labels ((set-b (n v)
               (multiple-value-bind (n b) (truncate n 8)
                 (setf (ldb (byte 1 b) (elt result n)) v))))
      (loop for (a . b) in pubkey
            for bs in encoded
            for hash = (funcall hashthunk bs)
            for n from 0
            do (cond ((equalp hash a) (set-b n 0))
                     ((equalp hash b) (set-b n 1))
                     (t (error "invalid hash n=~a hash=~a a=~a b=~a"
                               n hash a b)))
            finally (return result)))))

(defun decode-sha256 (pubkey encoded)
  (decode (lambda (a) (ironclad:digest-sequence :sha256 a))
          pubkey encoded))


#+nil
(time
 (let* ((privkey (mkpriv 256 512))
        (pubkey (priv->pub-sha256 privkey))
        (message (ironclad:digest-sequence :sha256 (ironclad:ascii-string-to-byte-array "Attack at dawn!"))))
   (equalp message (decode-sha256 pubkey (encode privkey message)))))

;;; User time    =        0.863
;;; System time  =        0.290
;;; Elapsed time =        1.140
;;; Allocation   = 134157184 bytes
;;; 0 Page faults