(defun randn (s n)
  "Regresa un numero aleatorio en [s, n)"
  (+ s (random (- n s))))

(defun mod-exp (base exponent modulus)
  "Calcula el exponente modular"
  (cond ((zerop exponent) 1)
        ((evenp exponent) (mod-exp (mod (* base base) modulus)
                                   (truncate exponent 2) modulus))
        ((oddp exponent) (mod (* base (mod-exp base
                                               (- exponent 1)
                                               modulus)) modulus))))

(defun run-witness (i n r d)
  "Revisa si n es un numero primo con i testigos diferentes"
  (cond ((<= i 0) t)
        ((witness (randn 2 (- n 1)) n r d) nil)
        (t (run-witness (- i 1) n r d))))

(defun inverse-modular-product (a n)
  "Calcula el inverso de a bajo el producto modulo n"
  (labels ((loop-fn (cur-t cur-r next-t next-r)
              (if (= next-r 0)
                (cond ((> cur-r 1) nil)
                      ((< cur-t 0) (+ cur-t n))
                      (t cur-t))
                (let ((quotient (floor cur-r next-r)))
                  (loop-fn next-t next-r
                           (- cur-t (* quotient next-t))
                           (- cur-r (* quotient next-r)))))))
    (loop-fn 0 n 1 a)))

(defun generate-keys (key-len)
  "Genera un par de llaves RSA con longitud key-len"
  (let* ((p (generate-prime (floor key-len 2)))
         (q (generate-prime (floor key-len 2)))
         (n (* p q))
         (cm (carmichael-totient p q))
         (e (coprime-in-range cm))
         (d (inverse-modular-product e cm)))
    (list e d n)))

(defun encrypt-num (m e n)
  "Encripta el numero m con la llave publica e n"
  (mod-exp m e n))

(defun decrypt-num (c d n)
  "Decripta un mensaje c con la llave privada d n"
  (mod-exp c d n))

(defun coprime-in-range (n)
  (do ((i (randn 2 n) (randn 2 n)))
      ((= (gcd i n) 1) i)))

(defun carmichael-totient (p q)
  "Calcula la función de carmichael para un numero n = pq"
  (lcm (- p 1) (- q 1)))

(defun generate-prime (upper-bits)
  (let* ((lower (expt 2 (- upper-bits 1)))
         (upper (* lower 2)))
    (do ((n (randn lower upper) (randn lower upper)))
        ((is-prime n 20) n))))

(defun split (n)
  "Factoriza n en dos numeros tales que 2^s*d = n"
  (do ((s 0 (+ s 1))
       (d n (floor d 2)))
      ((oddp d) (values s d))))

(defun is-prime (n k)
  "Indica si n es primo para n >=2"
  (cond ((<= n 1) nil)
        ((<= n 3) t)
        ((evenp n) nil)
        (t (multiple-value-bind (r d) (split (- n 1))
             (run-witness k n r d)))))

(defun witness-loop (i xi n)
  (let ((x (mod-exp xi 2 n)))
    (cond ((<= i 0) t)
          ((= x 1) t)
          ((= x (- n 1)) nil)
          (t (witness-loop (- i 1) x n)))))

(defun witness (a n r d)
  "Revisa si el testigo a demuestra que n no es primo."
  (let ((x (mod-exp a d n)))
    (if (or (= x 1) (= x (- n 1)))
        nil
        (witness-loop (- r 1) x n))))