Delete uuid.scm.

Signed-off-by: Munyoki Kilyungi <me@bonfacemunyoki.com>

1 files changed, 0 insertions, 234 deletions

diff --git a/transform/uuid.scm b/transform/uuid.scm
deleted file mode 100644
index be0e592..0000000
--- a/transform/uuid.scm
+++ /dev/null
@@ -1,234 +0,0 @@
-;; CREDIT: https://lists.gnu.org/archive/html/guile-user/2018-01/msg00019.html
-(define-module (transform uuid)
-  #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-11)
-  #:use-module (rnrs bytevectors)
-  #:use-module (ice-9 iconv)
-  #:export (bytevector->md5
-            make-version-3-uuid))
-
-(define (bytevector->md5 bytevector)
-  "Convert BYTEVECTOR to a bytevector containing the MD5 hash of
-BYTEVECTOR."
-  ;; Implemented along RFC 1321.  It should be easy to verify that
-  ;; this procedure performs the operations specified therein.
-  (define (append-padding-bits bytevector)
-    "Makes a list from BYTEVECTOR with padding as per RFC 1321 3.1."
-    (let* ((length-in-bits (* 8 (bytevector-length bytevector)))
-           (padding-bits (- 512 (modulo (- length-in-bits 448) 512))))
-      (append (bytevector->u8-list bytevector)
-              '(128) ; #*10000000
-               (iota
-		(- (/ padding-bits 8) 1)
-		0 0))))
-  (define (append-length msg-list message-length)
-    "Append MESSAGE-LENGTH as 8 byte values from a uint64 to MSG-LIST."
-    (append msg-list
-            ;; For numbers too large for an uint64, only the low-order
-            ;; bytes are returned.
-            (bytevector->u8-list (u64vector
-                                  (modulo
-                                   (* message-length 8) ; bits
-                                   (1+ #xffffffffffffffff))))))
-  (let hash ((AA #x67452301)
-             (BB #xefcdab89)
-             (CC #x98badcfe)
-             (DD #x10325476)
-             (to-digest
-              (append-length
-               (append-padding-bits
-                bytevector)
-               (bytevector-length bytevector))))
-    (define (F X Y Z)
-      (logior (logand X Y) (logand (lognot X) Z)))
-    (define (G X Y Z)
-      (logior (logand X Z) (logand Y (lognot Z))))
-    (define (H X Y Z)
-      (logxor X Y Z))
-    (define (I X Y Z)
-      (logxor Y (logior X (lognot Z))))
-    (define (T i)
-      (inexact->exact (floor (* 4294967296 (abs (sin i))))))
-    (define (number->u32 n)
-      "Cut off all bits that do not fit in a uint32."
-      (bit-extract n 0 32))
-    (define (lsh32 n count)
-      (number->u32 (logior (ash n count)
-                           (bit-extract n (- 32 count) 32))))
-    (if (not (null? to-digest))
-        (let* ((block (u8-list->bytevector
-                       (list-head to-digest (/ 512 8))))
-               (X (lambda (j) (bytevector-u32-ref
-                               block (* 4 j) (endianness little))))
-               (do-round1
-                (lambda (A B C D)
-                  (define (operation a b c d k s i)
-                    (number->u32
-                     (+ b (lsh32 (+ a (F b c d) (X k) (T i)) s))))
-                  (let* ((A (operation A B C D 0 7 1))
-                         (D (operation D A B C 1 12 2))
-                         (C (operation C D A B 2 17 3))
-                         (B (operation B C D A 3 22 4))
-                         (A (operation A B C D 4 7 5))
-                         (D (operation D A B C 5 12 6))
-                         (C (operation C D A B 6 17 7))
-                         (B (operation B C D A 7 22 8))
-                         (A (operation A B C D 8 7 9))
-                         (D (operation D A B C 9 12 10))
-                         (C (operation C D A B 10 17 11))
-                         (B (operation B C D A 11 22 12))
-                         (A (operation A B C D 12 7 13))
-                         (D (operation D A B C 13 12 14))
-                         (C (operation C D A B 14 17 15))
-                         (B (operation B C D A 15 22 16)))
-                    (values A B C D))))
-               (do-round2
-                (lambda (A B C D)
-                  (define (operation a b c d k s i)
-                    (number->u32
-                     (+ b (lsh32 (+ a (G b c d) (X k) (T i)) s))))
-                  (let* ((A (operation A B C D 1 5 17))
-                         (D (operation D A B C 6 9 18))
-                         (C (operation C D A B 11 14 19))
-                         (B (operation B C D A 0 20 20))
-                         (A (operation A B C D 5 5 21))
-                         (D (operation D A B C 10 9 22))
-                         (C (operation C D A B 15 14 23))
-                         (B (operation B C D A 4 20 24))
-                         (A (operation A B C D 9 5 25))
-                         (D (operation D A B C 14 9 26))
-                         (C (operation C D A B 3 14 27))
-                         (B (operation B C D A 8 20 28))
-                         (A (operation A B C D 13 5 29))
-                         (D (operation D A B C 2 9 30))
-                         (C (operation C D A B 7 14 31))
-                         (B (operation B C D A 12 20 32)))
-                    (values A B C D))))
-               (do-round3
-                (lambda (A B C D)
-                  (define (operation a b c d k s i)
-                    (number->u32
-                     (+ b (lsh32 (+ a (H b c d) (X k) (T i)) s))))
-                  (let* ((A (operation A B C D 5 4 33))
-                         (D (operation D A B C 8 11 34))
-                         (C (operation C D A B 11 16 35))
-                         (B (operation B C D A 14 23 36))
-                         (A (operation A B C D 1 4 37))
-                         (D (operation D A B C 4 11 38))
-                         (C (operation C D A B 7 16 39))
-                         (B (operation B C D A 10 23 40))
-                         (A (operation A B C D 13 4 41))
-                         (D (operation D A B C 0 11 42))
-                         (C (operation C D A B 3 16 43))
-                         (B (operation B C D A 6 23 44))
-                         (A (operation A B C D 9 4 45))
-                         (D (operation D A B C 12 11 46))
-                         (C (operation C D A B 15 16 47))
-                         (B (operation B C D A 2 23 48)))
-                    (values A B C D))))
-               (do-round4
-                (lambda (A B C D)
-                  (define (operation a b c d k s i)
-                    (number->u32
-                     (+ b (lsh32 (+ a (I b c d) (X k) (T i)) s))))
-                  (let* ((A (operation A B C D 0 6 49))
-                         (D (operation D A B C 7 10 50))
-                         (C (operation C D A B 14 15 51))
-                         (B (operation B C D A 5 21 52))
-                         (A (operation A B C D 12 6 53))
-                         (D (operation D A B C 3 10 54))
-                         (C (operation C D A B 10 15 55))
-                         (B (operation B C D A 1 21 56))
-                         (A (operation A B C D 8 6 57))
-                         (D (operation D A B C 15 10 58))
-                         (C (operation C D A B 6 15 59))
-                         (B (operation B C D A 13 21 60))
-                         (A (operation A B C D 4 6 61))
-                         (D (operation D A B C 11 10 62))
-                         (C (operation C D A B 2 15 63))
-                         (B (operation B C D A 9 21 64)))
-                    (values A B C D)))))
-          (let*-values (((A B C D) (values AA BB CC DD))
-                        ((A B C D) (do-round1 A B C D))
-                        ((A B C D) (do-round2 A B C D))
-                        ((A B C D) (do-round3 A B C D))
-                        ((A B C D) (do-round4 A B C D)))
-            (hash (number->u32 (+ A AA))
-                  (number->u32 (+ B BB))
-                  (number->u32 (+ C CC))
-                  (number->u32 (+ D DD))
-                  (list-tail to-digest (/ 512 8)))))
-        ;; we’re done:
-        (u8-list->bytevector
-         (append
-          (bytevector->u8-list (u32vector AA))
-          (bytevector->u8-list (u32vector BB))
-          (bytevector->u8-list (u32vector CC))
-          (bytevector->u8-list (u32vector DD)))))))
-
-(define* (make-version-3-uuid namespace-uuid str #:optional (prefix "urn:uuid:"))
-  "Generates a UUID string by computing the MD5 hash of NAMESPACE-UUID
-and STR.  NAMESPACE-UUID must be a bytevector consisting of the UUID’s
-bytes, *not* the UUID’s string representation."
-  (define (half-byte->hex-char number)
-    "Returns the corresponding hexadecimal digit for a number NUMBER
-between 0 and 15."
-    (case number
-      ((0) #\0)
-      ((1) #\1)
-      ((2) #\2)
-      ((3) #\3)
-      ((4) #\4)
-      ((5) #\5)
-      ((6) #\6)
-      ((7) #\7)
-      ((8) #\8)
-      ((9) #\9)
-      ((10) #\a)
-      ((11) #\b)
-      ((12) #\c)
-      ((13) #\d)
-      ((14) #\e)
-      ((15) #\f)))
-  (define (byte->hex-string bv index)
-    "Convert the byte at INDEX of bytevector BV to a hex string."
-    (let ((byte (bytevector-u8-ref bv index)))
-      (string (half-byte->hex-char (quotient byte 16))
-              (half-byte->hex-char (modulo byte 16)))))
-  (let ((md5 (bytevector->md5
-              (u8-list->bytevector
-               (append (bytevector->u8-list namespace-uuid)
-                       (bytevector->u8-list (string->utf8 str)))))))
-    (string-append prefix
-                   ;; time_low field:
-                   (byte->hex-string md5 0)
-                   (byte->hex-string md5 1)
-                   (byte->hex-string md5 2)
-                   (byte->hex-string md5 3)
-                   "-"
-                   ;; time_mid field:
-                   (byte->hex-string md5 4)
-                   (byte->hex-string md5 5)
-                   "-"
-                   ;; time_hi_and_version field:
-                   (let ((byte (bytevector-u8-ref md5 6)))
-                     (string (half-byte->hex-char 3) ; UUID version 3
-                             (half-byte->hex-char (modulo byte 16))))
-                   (byte->hex-string md5 7)
-                   "-"
-                   ;; clock_seq_hi_and_reserved field:
-                   (let ((byte (bytevector-u8-ref md5 8)))
-                     (string (half-byte->hex-char
-                              (logior #b1000 ; most significant bits are 10
-                                      (bit-extract (quotient byte 16) 0 2)))
-                             (half-byte->hex-char (modulo byte 16))))
-                   ;; clock_seq_low field:
-                   (byte->hex-string md5 9)
-                   "-"
-                   ;; node field:
-                   (byte->hex-string md5 10)
-                   (byte->hex-string md5 11)
-                   (byte->hex-string md5 12)
-                   (byte->hex-string md5 13)
-                   (byte->hex-string md5 14)
-                   (byte->hex-string md5 15))))