(module pbkdf2
 (pbkdf2
  make-salt)

 (import scheme chicken)

 (use srfi-1)
 (use srfi-4 srfi-27 entropy-unix)

(use
  sha2
  message-digest
  hmac
  loops
  base64
  string-utils
)

(define dklen 32)
(define password "spider")
(define salt "salty")
(define iterations 10000)
(define digest sha256-primitive)


(define hlen (string-length (message-digest-string (digest) "x")))

(if (not dklen) (set! dklen hlen) '())
(if (> dklen (* 4294967295 hlen)) (error 'dklen "Overflow, dklen too large") '()) ;ensures dklen < 2^32

(define l (inexact->exact (ceiling (/ dklen hlen)))) ;determines the number of blocks dklen will be broken into
(define r (- dklen (* (- l 1) hlen)))                ;determines the length of the remainder block

(define (hmac-sha256 key message)
  ((hmac key (sha256-primitive)) message))  ;slower implementation (that actually works)
;    (if (> (string-length key) 64)
;        (set! key (sha256 key))
;        (set! key (string-pad-right key 64 #\x00))
;    )
;    
;    
;    (define o-key-pad  (string-map (lambda (x) (integer->char (bitwise-xor 92 (char->integer x)))) key))
;    (define i-key-pad  (string-map (lambda (x) (integer->char (bitwise-xor 54 (char->integer x)))) key))
;    (sha256 (string-append o-key-pad (sha256 (string-append i-key-pad message))))
;)

(define (sha256 x) (message-digest-string (sha256-primitive) x))

(define (U u xor count)
  (if (= count iterations) xor  
    (let* ((new-u (hmac-sha256 password u)))
      (U new-u (string-xor xor new-u) (+ count 1))
    )
  )
)

(define (F i)
  (let* ((salt-i (string-append salt (int->4bytestring i)))
         (u1 (hmac-sha256 password salt-i)))
        (U u1 u1 1)
  )
)

(define (T)
  (let* ((tlist '()))
    (do-times x l (set! tlist (append tlist (list (F (+ x 1))))))
    tlist
  )
)
  
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;FOR CONVERTING INTEGERS TO 4 BYTE STRINGS;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;supports encoding ints up to 2^32;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (int->dhex x) 
  (if (< x 256) 
    (list x) 
    (append 
      (int->dhex (quotient x 256)) 
      (list (modulo x 256)))
      )
    )
    
(define (pad x) (if (< (length x) 4) (pad (append (list 0) x)) x))
(define (int->padhex x) (pad (int->dhex x)))

(define (int->4bytestring x)
  (let* 
    ((padhex (int->padhex x))
     (charlist (map integer->char padhex)))
    (apply string charlist))
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;For XORing strings together;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    
(define (char-xor x y)
 (let* ((num (bitwise-xor (char->integer x) (char->integer y))))
      (integer->char num)
   )
 )
(define (string-xor x y)
 (list->string (map char-xor (string->list x) (string->list y)))
)


  
  
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

  
(define (pbkdf2 _password _salt _iterations );_dklen) 
  (set! password _password)
  (set! salt _salt)
  (set! iterations _iterations)
  (let* ((tlist (T))
         (listlen (length tlist))
         (last-elem (list-ref tlist (- listlen 1)))
         (almost-list (apply string-append (take tlist (- listlen 1))))
         (last-elem-list (string->list last-elem))
         (tstring (string-append almost-list (list->string (take last-elem-list r)))))
         (base64-encode tstring)
        
  )
)

;(do-times _ 10 (pbkdf2 "spider" "salt" 10000)) ;for benchmarking

; Randomness for password algorithms

(define (u8vectors->base64 vec)
    (base64-encode (blob->string (u8vector->blob/shared vec))))


(define (make-secret-generator)
  (let ((source (make-entropy-source-urandom-device)))
    (lambda (byte-width)
      (u8vectors->base64
	(entropy-source-u8vector source byte-width)))))

(define make-salt
  (make-secret-generator))


)