(load "~/quicklisp/setup.lisp")
(ql:quickload :ironclad)
(ql:quickload :split-sequence)

(defvar *first-segwit* 481824)

(defmacro with-binary-output-to-vector
    ((stream-var &optional (vector-or-size-form 0)
		 &key (adjustable (and (integerp vector-or-size-form)
				       (zerop vector-or-size-form)))
		 (fill-pointer 0)
		 (element-type ''(unsigned-byte 8))
		 (on-full-array :error))
     &body body)
    "Arrange for STREAM-VAR to collect octets in a vector.
VECTOR-OR-SIZE-FORM is either a form that evaluates to a vector, or an
integer in which case a new vector of that size is created. The vector's
fill-pointer is used as the write-index. If ADJUSTABLE nil (or not provided),
an error will occur if the array is too small. Otherwise, the array will
be adjusted in size, using VECTOR-PUSH-EXTEND. If ADJUSTABLE is an integer,
that value will be passed as the EXTENSION argument to VECTOR-PUSH-EXTEND.
If VECTOR-OR-SIZE-FORM is an integer, the created vector is returned,
otherwise the value of BODY."
    (let ((vector-form
	   (if (integerp vector-or-size-form)
	       `(make-array ,vector-or-size-form
			    :element-type ,element-type
			    :adjustable ,(and adjustable t)
			    :fill-pointer ,fill-pointer)
	       vector-or-size-form)))
      (let ((save-bwb-var (make-symbol "save-bwb")))
	`(let* ((,save-bwb-var *binary-write-byte*)
		(,stream-var ,vector-form)
		(*binary-write-byte*
		 #'(lambda (byte stream)
		     (if (eq stream ,stream-var)
			 ,(cond
			   (adjustable
			    `(vector-push-extend byte stream
						 ,@(when (integerp adjustable)
							 (list adjustable))))
			   ((eq on-full-array :error)
			    `(assert (vector-push byte stream) (stream)
				     "Binary output vector is full when writing byte value ~S: ~S"
				     byte stream))
			   ((eq on-full-array :ignore)
			    `(vector-push byte stream))
			   (t (error "Unknown ON-FULL-ARRAY argument ~S, must be one of :ERROR, :IGNORE."
				     on-full-array)))
			 (funcall ,save-bwb-var byte stream)))))
	   ,@body
	   ,@(when (integerp vector-or-size-form)
		   (list stream-var))))))

;; This works based on a shaky assumption of what request-blk-data-from-ben returns.
(defun get-txns-from-blk-data (blk-data)
  (let ((transactions (car (cddddr (cddddr blk-data)))))
    (if (eq (car transactions) :transactions) ; Sanity check
	(cadr transactions)
	())))

(defvar *binary-write-byte* #'common-lisp:write-byte
    "The low-level WRITE-BYTE function used by binary-types.")

(defun write-binary-little-endian (num-bytes stream value)
  (if (= 1 num-bytes)
      ;; TODO: Check if this is necessary.
      (progn (funcall *binary-write-byte* value stream) 1)
      (progn
	(dotimes (i num-bytes)
	;; TODO: Proofread ldb
	  (funcall *binary-write-byte* (ldb (byte 8 (* 8 i)) value) stream))
      ;; TODO Find out why original write-binary had this
      num-bytes)))

(defun write-compact-size (value stream)
  (cond
    ((< value 253) (write-binary-little-endian 1 stream value))
    ((< value 65535)
     (progn
       (write-binary-little-endian 1 stream #XFD)
       (write-binary-little-endian 2 stream value)))
    ((< value 4294967295)
     (progn
       (write-binary-little-endian 1 stream #XFE)
       (write-binary-little-endian 4 stream value)))
    (t (progn
         (write-binary-little-endian 1 stream #XFF)
         (write-binary-little-endian 8 stream value)))))

;; txn accessors
(defun get-version (txn)
  (getf txn :version))

(defun get-lock-time (txn)
  (getf txn :lock-time))

(defun get-outputs (txn)
  (getf txn :outputs))

;; (with-slots (satoshis output-script)
(defun get-satoshis (output)
  (cdar output))

(defun get-output-script (output)
  (cadadr output))

(defun get-inputs (txn)
  (getf txn :inputs))

(defun get-hash (input)
  (parse-integer (cdar input) :radix 16))

(defun get-hash-as-string (input)
  (cdar input))

(defun get-index (input)
  (cdadr input))

(defun get-script (input)
  (car (cdaddr input)))

(defun get-sequence-number (input)
  (cdr (cadddr input)))

(defun hash-txn (txn)
  (let ((version (get-version txn))
	(inputs (get-inputs txn))
	(outputs (get-outputs txn))
	(lock-time (get-lock-time txn)))
    (with-binary-output-to-vector
        (bytes (make-array 1000000 :fill-pointer 0 :adjustable t :element-type '(unsigned-byte 8)))
      (write-binary-little-endian 4 bytes version)
      (write-compact-size (length inputs) bytes)
      (loop for i in inputs do
	   (let ((hash (get-hash i))
		 (index (get-index i))
		 (script (get-script i))
		 (sequence-number (get-sequence-number i)))
             (write-binary-little-endian 32 bytes hash)
             (write-binary-little-endian 4 bytes index)
             (write-compact-size (length script) bytes)
             (loop for b in script do (write-binary-little-endian 1 bytes b))
             (write-binary-little-endian 4 bytes sequence-number)))
      (write-compact-size (length outputs) bytes)
      (loop for o in outputs do
	   (let ((satoshis (get-satoshis o)) (output-script (get-output-script o)))
             (write-binary-little-endian 8 bytes satoshis)
             (write-compact-size (length output-script) bytes)
             (loop for b in output-script do (write-binary-little-endian 1 bytes b))))
      (write-binary-little-endian 4 bytes lock-time)
      (reverse (ironclad:digest-sequence :sha256 (ironclad:digest-sequence :sha256 bytes))))))

(defun hash-to-symbol-list (txn-hash)
  (read-from-string (subseq (format nil "~60,'0X" txn-hash) 1)))

(defun hash-symbol-to-string-no-prefix (hash-symbol)
  (if (typep hash-symbol 'integer)
      (write-to-string hash-symbol)
      (string hash-symbol)))

(defun hash-symbol-to-hex-string (hash-symbol)
  (let ((hash-str (hash-symbol-to-string-no-prefix hash-symbol)))
    (if (eq (length hash-str) 1)
	(concatenate 'string "0" hash-str)
	hash-str)))

(defun hash-symbol-list-to-string (hash-symbol-list)
  (let ((hash-str ""))
    (loop for hash-symbol in hash-symbol-list do
	 (setq hash-str (concatenate 'string hash-str (hash-symbol-to-hex-string hash-symbol))))
    (string-left-trim "0" hash-str)))

(defun txn-to-hash-str (txn)
  (hash-symbol-list-to-string (hash-to-symbol-list (hash-txn txn))))

(defun file-get-contents (filename)
  (with-open-file (stream filename)
    (let ((contents (make-string (file-length stream))))
      (read-sequence contents stream)
            contents)))

(defvar *file-root* "~/saved-sexprs/")
(defun get-txns (blk-num)
  (let ((file-name (concatenate 'string *file-root* "blk" (write-to-string blk-num))))
    (if (probe-file file-name)
	;; TODO Decouple
	(get-txns-from-blk-data (read-from-string (file-get-contents file-name))))))


;; TODO Verify that the tuple (satoshis, value) is always the first element in an output.

;; TODO Verify that tuple (destination-addr, value) or (destination-addr) is always last
;; element in the output.
(defun get-destination-addr (output)
  (cdaddr output))

(defun is-non-trb-output? (output)
  (not (get-destination-addr output)))

(defun get-non-trb-outputs (txn)
  (let ((non-trb-outputs ()) (output-index 0))
    (loop for output in (get-outputs txn) do
	 (if (is-non-trb-output? output)
	     (setf non-trb-outputs
		   (append
		    non-trb-outputs
		    ;; TODO: Figure out how to do this properly.
		    (list (list (txn-to-hash-str txn) output-index (get-satoshis output))))))
	 (incf output-index))
    non-trb-outputs))

(defparameter *non-trb-outputs-hash* (make-hash-table :test #'equal))

(defun reset-db()
  (defparameter *non-trb-outputs-hash* (make-hash-table :test #'equal)))

(defun store-non-trb-output (non-trb-output)
  (let ((txn-hash (car non-trb-output))
	(output-index (cadr non-trb-output))
	(satoshis (caddr non-trb-output)))
    (if (null (getf (gethash txn-hash *non-trb-outputs-hash*) output-index))
	(setf (gethash txn-hash *non-trb-outputs-hash*)
	      (append (gethash txn-hash *non-trb-outputs-hash*) `(,output-index ,satoshis))))))

;; Marks non-trb outputs as spent.
(defun mark-outputs-spent (txn)
  (loop for input in (get-inputs txn) do
       (let ((hash (get-hash-as-string input)) (index (get-index input)))
	 (let ((old-outputs (gethash hash *non-trb-outputs-hash*)))
	   (if old-outputs
	       (progn
		 (remf old-outputs index)
		 (if old-outputs
		     (setf (gethash hash *non-trb-outputs-hash*) old-outputs)
		     (remhash hash *on-trb-outputs-hash*))))))))

(defun loop-store-non-trb-outputs (start-blk end-blk)
  (loop for i from start-blk to end-blk do
       (print i)
       (loop for txn in (get-txns i) do
	    (mark-outputs-spent txn)
	    (loop for output in (get-non-trb-outputs txn) do
		 (store-non-trb-output output)))))

(defvar *output-sum* 0)

(defvar *save-file* "~/non-trb-outputs")

(defun save-hash (save-file hash-table)
  (let ((hash-tuple ()))
    (maphash
     (lambda (key value) (push `(,key ,value) hash-tuple)) hash-table)
    (with-open-file (out save-file :direction :output :if-exists :supersede)
      (with-standard-io-syntax
	(print hash-tuple out)))))

(defun load-hash (save-file hash-table)
  (reset-db)
  (let ((hash-tuple ()))
    (with-open-file (in save-file)
      (with-standard-io-syntax
	(setf hash-tuple (read in))))
    (mapcar (lambda (record) (setf (gethash (car record) hash-table) (cadr record)))
	    hash-tuple)))

(defparameter *new-trb-outputs-hash* (make-hash-table :test #'equal))
(defun convert-old-hash ()
  (maphash
   (lambda (old-key old-satoshis)
     (let ((hash-index (split-sequence:SPLIT-SEQUENCE #\: old-key)))
       (let ((hash (car hash-index)) (index (parse-integer (cadr hash-index))))
	 (let ((new-value (gethash hash *new-trb-outputs-hash*)))
	   (print hash)
	   (print new-value)
	   (setf (gethash hash *new-trb-outputs-hash*)
		 (append new-value `(,index ,(car old-satoshis))))))))
   *non-trb-outputs-hash*))

(defun print-hash (key value)
  (print key)
  (print value))

(defun print-nulls (key value)
  (if (null value)
      (print key)))

(defun count-output-sum (txn-hash outputs)
  ;; the second element in the list of the hash table is the block where the output was spent.
  ;; If it is null then it was not spent.
  (loop for (output-index satoshis) on outputs by #'cddr do
       (setf *output-sum* (+ *output-sum* satoshis))))

(defun count-total-output-sum ()
  (setf *output-sum* 0)
  (maphash #'count-output-sum *non-trb-outputs-hash*)
  (print (satoshi-to-btc *output-sum*)))

(defun new-count-total-output-sum ()
(setf *output-sum* 0)
  (maphash #'count-output-sum *non-trb-outputs-hash*)
  (print (satoshi-to-btc *output-sum*)))


(defun loop-and-save-100 (start-value)
    (loop for i from 0 to 300 do
	 (let ((start (+ start-value (* i 100))))
	   (let ((end (+ start 100)))
	     (loop-store-non-trb-outputs start end)
	     (save-hash
	      (concatenate 'string "~/saved-" (write-to-string end)) *non-trb-outputs-hash*)))))


(defun satoshi-to-btc (satoshis)
  (/ satoshis 100000000.0))

;(loop-and-save-100 489668)

;;(defvar *counter* 483000)
;;(loop for i from 1 to 15 do
;;     (let ((start (+ *counter* (* i 1000))) (end (+ *counter* 1000 (* i 1000))))
;;       (loop-store-non-trb-outputs start end)

;;(loop-store-non-trb-outputs 483000 484000)
;;(save-non-trb-outputs-hash "save-484000")
;;(print "saved-484000")
;;(loop-store-non-trb-outputs 484000 485000)
;;(save-non-trb-outputs-hash "save-485000")
;;(print "saved-485000")