base32-ulid.lisp

;;; ULID binary layout (https://github.com/ulid/spec)
;;;
;;; 0                   1                   2                   3
;;;  0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1
;;; +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
;;; |                      32_bit_uint_time_high                    |
;;; +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
;;; |     16_bit_uint_time_low      |       16_bit_uint_random      |
;;; +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
;;; |                       32_bit_uint_random                      |
;;; +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
;;; |                       32_bit_uint_random                      |
;;; +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
;;; (note: for base32, two "0" bits are placed in front of uint_time)

(defmacro aprog1 (f . fs) `(let ((it ,f)) ,@fs it)) ; anaphoric prog1
(defvar *ulid-base32-chars* "0123456789ABCDEFGHJKMNPQRSTVWXYZ")
(defun base32 (i) (char *ulid-base32-chars* i))
(defun div32  (x) (multiple-value-list (floor x 32)))

(defun conv-to-base32 (value str start end)
  (loop for i from end downto start
        for (q r) = (div32 value) then (div32 q)
        do (setf (char str i) (base32 r))))

(defun make-base32-ulid (time rndm)
  (aprog1 (make-string 26)
    (conv-to-base32 time it  0  9)
    (conv-to-base32 rndm it 10 25)))

(defvar +80bits-limit+ (expt 2 80))

;; FIXME: prefarably we should use Cryptographic-RNG instead of RANDOM
(defun base32-ulid (&optional time-in-msec random)
  (make-base32-ulid (or time-in-msec (get-current-time-in-msec))
                    (or random (RANDOM +80bits-limit+))))

#|
(defun get-current-time-in-msec ()
  ...)
|#