;;; Copyright © 2017  Amirouche Boubekki <address@hidden>
;;
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
;;
;; Comment:
;;
;;  https://martinfowler.com/articles/web-security-basics.html
;;
(define-module (argon2))

(use-modules (ice-9 binary-ports))
(use-modules (ice-9 iconv))
(use-modules (rnrs bytevectors))
(use-modules (system foreign))


(define (urandom length)
  "Return a bytevector of length LENGTH generated by /dev/urandom"
  (let ((bv (make-bytevector length)))
    (call-with-input-file "/dev/urandom"
      (lambda (port)
        (let loop ((index 0))
          (unless (eq? index length)
            (let ((byte (get-u8 port)))
              (bytevector-u8-set! bv index byte)
              (loop (+ index 1))))))
      #:binary #true)
    bv))

(define* (dynamic-link* #:optional library-name)
  (let ((shared-object (if library-name
                           (dynamic-link library-name)
                           (dynamic-link))))
    (lambda (return-value function-name . arguments)
      (let ((function (dynamic-func function-name shared-object)))
        (pointer->procedure return-value function arguments)))))

(define argon2 (dynamic-link* "/usr/lib/x86_64-linux-gnu/libargon2.so"))

(define error-message
  (let ((func (argon2 '*
                       "argon2_error_message"
                       int)))
    (lambda (error-code)
      (pointer->string (func error-code)))))

(define encoded-length
  (let ((func (argon2 size_t
                      "argon2_encodedlen"
                      uint32
                      uint32
                      uint32
                      uint32
                      uint32)))
    (lambda (time-cost memory-cost parallelism salt-length hash-length)
      (func time-cost memory-cost parallelism salt-length hash-length))))

(define argon2i-hash-encode
  (let ((func (argon2 int
                      "argon2i_hash_encoded"
                      uint32    ;; t_cost number of iterations
                      uint32    ;; m_cost memory usage 
                      uint32    ;; parallelism number
                      '*        ;; password
                      size_t    ;; password length
                      '*        ;; salt 
                      size_t    ;; salt length
                      size_t    ;; desired length of the hash in bytes
                      '*        ;; buffer
                      size_t))) ;; buffer length
    (lambda (time-cost memory-cost parallelism password salt hash-length length)
      (let ((hash (make-bytevector length)))
        (let ((out (func time-cost
                         memory-cost
                         parallelism
                         (bytevector->pointer password)
                         (bytevector-length password)
                         (if salt (bytevector->pointer salt) %null-pointer)
                         (if salt (bytevector-length salt) 0)
                         hash-length
                         (bytevector->pointer hash)
                         length)))
          (if (zero? out)
            hash
            (throw 'argon2 (error-message out))))))))

(define-public (hash-secret password)
  (let ((time-cost 2)  ;; default values from argon2_cffi
        (memory-cost 512)
        (parallelism 2)
        (length 16)
        (salt (urandom 16)))
    (let ((total (encoded-length time-cost
                                 memory-cost
                                 parallelism
                                 length
                                 length)))
      (utf8->string (argon2i-hash-encode time-cost
                                         memory-cost
                                         parallelism
                                         (string->utf8 password)
                                         salt
                                         length
                                         total)))))

(define argon2i-verify (argon2 int
                               "argon2i_verify"
                               '*
                               '*
                               size_t))

(define-public (verify encoded password)
  (let ((password* (string->utf8 password)))
    (let ((out (argon2i-verify (bytevector->pointer (string->utf8 encoded))
                               (bytevector->pointer password*)
                               (bytevector-length password*))))
      (if (zero? out)
          #t
          (throw 'argon2 (error-message out))))))