From 7d73afba99309c41f13f0dfe7ddc18b5d975783c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=C3=81kos=20Kiss?= Date: Thu, 1 Jun 2023 06:46:24 +0200 Subject: [PATCH] Initial commit --- .gitignore | 2 + LICENSE | 21 ++++++++++ README.org | 43 ++++++++++++++++++++ frugal-uuid-test.lisp | 59 +++++++++++++++++++++++++++ frugal-uuid-v4.lisp | 17 ++++++++ frugal-uuid.asd | 21 ++++++++++ frugal-uuid.lisp | 95 +++++++++++++++++++++++++++++++++++++++++++ package.lisp | 16 ++++++++ 8 files changed, 274 insertions(+) create mode 100644 .gitignore create mode 100644 LICENSE create mode 100644 README.org create mode 100644 frugal-uuid-test.lisp create mode 100644 frugal-uuid-v4.lisp create mode 100644 frugal-uuid.asd create mode 100644 frugal-uuid.lisp create mode 100644 package.lisp diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..65b9f37 --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ +*.fasl +*.fas diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..4a1a677 --- /dev/null +++ b/LICENSE @@ -0,0 +1,21 @@ +MIT License + +Copyright (c) 2023 Ákos Kiss + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/README.org b/README.org new file mode 100644 index 0000000..c55c72c --- /dev/null +++ b/README.org @@ -0,0 +1,43 @@ +* cl-frugal-uuid (WiP) + +Common Lisp [[https://en.wikipedia.org/wiki/Universally_unique_identifier][UUID]] library with zero dependencies + +** Rationale + +- Permissive license (MIT) +- Small (e.g. doesn't rely on [[https://github.com/sharplispers/ironclad][Ironclad]]) + +** Limitations + +Currently only generating random UUIDs (Version 4) is supported. + +** Installation + +cl-frugal-uuid can be installed via [[https://www.quicklisp.org/][Quicklisp]] from the [[https://ultralisp.org/][Ultralisp]] +distribution: + +#+begin_src lisp + (ql-dist:install-dist "http://dist.ultralisp.org/" :prompt nil) + (ql:quickload :frugal-uuid) +#+end_src + +** Running tests + +- Load the tests via Quicklisp: + +#+begin_src lisp + (ql:quickload :frugal-uuid/test) +#+end_src + +- Use [[https://asdf.common-lisp.dev/][ASDF]] or [[https://fiveam.common-lisp.dev/][FiveAM]] to run the tests: + +#+begin_src lisp + ;; Using ASDF: + (asdf:test-system :frugal-uuid) + ;; Using FiveAM directly: + (fiveam:run! :frugal-uuid) +#+end_src + +** Legal + +- Released under the MIT License. diff --git a/frugal-uuid-test.lisp b/frugal-uuid-test.lisp new file mode 100644 index 0000000..2f76b3b --- /dev/null +++ b/frugal-uuid-test.lisp @@ -0,0 +1,59 @@ +;;;; frugal-uuid-test.lisp + +(defpackage #:frugal-uuid-test + (:use #:cl #:fiveam)) + +(in-package #:frugal-uuid-test) + +(def-suite :frugal-uuid) +(in-suite :frugal-uuid) + +(test integer-conversion + (is (fuuid:uuid= (fuuid:make-nil) (fuuid:from-integer 0))) + (is (eql 0 (fuuid:to-integer (fuuid:make-nil)))) + (dotimes (_ 20) + (let* ((uuid (fuuid:make-v4)) + (i (fuuid:to-integer uuid))) + (is (integerp i)) + (is (fuuid:uuid= uuid (fuuid:from-integer i)))))) + +(test string-conversion + (is (string= "00000000-0000-0000-0000-000000000000" + (fuuid:to-string (fuuid:make-nil)))) + (is (fuuid:uuid= (fuuid:make-nil) + (fuuid:from-string "00000000-0000-0000-0000-000000000000"))) + (dotimes (_ 20) + (let* ((uuid (fuuid:make-v4)) + (s (fuuid:to-string uuid))) + (is (stringp s)) + (is (fuuid:uuid= uuid (fuuid:from-string s)))))) + +(test equality + (is (fuuid:uuid= (fuuid:make-nil) (fuuid:make-nil))) + (is (fuuid:uuid-equal-p nil nil)) + (is (not (fuuid:uuid-equal-p nil (fuuid:make-nil)))) + (dotimes (_ 10) + (let* ((uuid (fuuid:make-v4)) + (s (fuuid:to-string uuid))) + (is (fuuid:uuid-equal-p uuid s)) + (is (fuuid:uuid-equal-p s uuid)) + (is (fuuid:uuid-equal-p uuid uuid)) + (is (fuuid:uuid-equal-p s (fuuid:to-string uuid))))) + (is (loop :with uuids := '("00000000-0000-0000-0000-000000000000" + "ef4c23eb-1fc0-4216-981d-9e24d512d9f4" + "3dbbd860-a35c-47df-8952-7604398ad84c" + "9215d239-4d04-4e1b-8dda-61e647bc2fc7" + "a4cb7801-d568-47b6-a2bf-e3b7e0770e76" + "0b817bd9-58e1-4352-93ca-549e0c91024f" + "f9e035f7-d2ea-46a4-827f-7cd19961fa3c" + "0ce58808-9db1-447a-a2ac-241b413ad409" + "dce81bfb-b6ce-4982-9ed3-e0010c21a8b9" + "67e64cf2-ad4a-4661-9b5d-e8c51d54c913" + "023b9bc2-3c24-4b8d-8294-2ac0858dff71") + :for a :in uuids + :count (loop :for b :in uuids + :count (or (fuuid:uuid-equal-p a b) + (fuuid:uuid= (fuuid:from-string a) + (fuuid:from-string b)))) + :into n + :finally (return (eql (length uuids) n))))) diff --git a/frugal-uuid-v4.lisp b/frugal-uuid-v4.lisp new file mode 100644 index 0000000..0e6f1ce --- /dev/null +++ b/frugal-uuid-v4.lisp @@ -0,0 +1,17 @@ +;;;; frugal-uuid-v4.lisp + +(in-package #:frugal-uuid) + +(defvar *random* nil) + +(defun make-v4 (&optional random-state) + (unless *random* (setf *random* (make-random-state t))) + ;; Generate 128-bit random value + (let ((base (random #xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + (or random-state *random*)))) + ;; Set version to random + (setf (ldb (byte 4 76) base) #x4) + ;; Set variant to IETF + (setf (ldb (byte 2 62) base) 2) + (from-integer base))) + diff --git a/frugal-uuid.asd b/frugal-uuid.asd new file mode 100644 index 0000000..0aee6a4 --- /dev/null +++ b/frugal-uuid.asd @@ -0,0 +1,21 @@ +;;;; frugal-uuid.asd + +(asdf:defsystem #:frugal-uuid + :description "Common Lisp UUID library with zero dependencies" + :author "Ákos Kiss " + :license "MIT License" + :serial t + :components ((:file "package") + (:file "frugal-uuid") + (:file "frugal-uuid-v4")) + :in-order-to ((test-op (test-op "frugal-uuid/test")))) + +(asdf:defsystem #:frugal-uuid/test + :depends-on (#:frugal-uuid + #:fiveam) + :components ((:file "frugal-uuid-test")) + :perform (test-op (o c) (symbol-call :fiveam '#:run! :frugal-uuid))) + +(asdf:defsystem #:frugal-uuid/* + :depends-on (#:frugal-uuid + #:frugal-uuid/test)) diff --git a/frugal-uuid.lisp b/frugal-uuid.lisp new file mode 100644 index 0000000..b68ab91 --- /dev/null +++ b/frugal-uuid.lisp @@ -0,0 +1,95 @@ +;;;; frugal-uuid.lisp + +(in-package #:frugal-uuid) + +(defclass uuid () + ((time-low :initarg :time-low + :accessor time-low + :type (unsigned-byte 32)) + (time-mid :initarg :time-mid + :accessor time-mid + :type (unsigned-byte 16)) + (time-hi-and-version :initarg :time-hi-and-version + :accessor time-hi-and-version + :type (unsigned-byte 16)) + (clock-seq-hi-and-res :initarg :clock-seq-hi-and-res + :accessor clock-seq-hi-and-res + :type (unsigned-byte 8)) + (clock-seq-low :initarg :clock-seq-low + :accessor clock-seq-low + :type (unsigned-byte 8)) + (node :initarg :node + :accessor node + :type (unsigned-byte 48)))) + +(defun from-integer (i) + (make-instance 'uuid + :time-low (ldb (byte 32 96) i) + :time-mid (ldb (byte 16 80) i) + :time-hi-and-version (ldb (byte 16 64) i) + :clock-seq-hi-and-res (ldb (byte 8 56) i) + :clock-seq-low (ldb (byte 8 48) i) + :node (ldb (byte 48 0) i))) + +(defun to-integer (uuid) + (let ((i 0)) + (setf (ldb (byte 32 96) i) (time-low uuid) + (ldb (byte 16 80) i) (time-mid uuid) + (ldb (byte 16 64) i) (time-hi-and-version uuid) + (ldb (byte 8 56) i) (clock-seq-hi-and-res uuid) + (ldb (byte 8 48) i) (clock-seq-low uuid) + (ldb (byte 48 0) i) (node uuid)) + i)) + +(defun from-string (s) + (unless (eql (length s) 36) + (error "UUID parse error: expected input string of length 36.")) + (loop + :for i :in '(8 13 18 23) + :for c := (aref s i) + :unless (eql c #\-) + :do (error "UUID parse error: expected - at index ~a, found ~a instead." i c)) + (from-integer (parse-integer (remove #\- s) :radix 16))) + +(defun to-string (uuid) + (format nil "~(~8,'0x-~4,'0x-~4,'0x-~2,'0x~2,'0x-~12,'0x~)" + (time-low uuid) + (time-mid uuid) + (time-hi-and-version uuid) + (clock-seq-hi-and-res uuid) + (clock-seq-low uuid) + (node uuid))) + +(defmethod print-object ((uuid uuid) stream) + (print-unreadable-object (uuid stream :type t) + (format stream (to-string uuid)))) + +(defun make-nil () + (make-instance 'uuid + :time-low 0 + :time-mid 0 + :time-hi-and-version 0 + :clock-seq-hi-and-res 0 + :clock-seq-low 0 + :node 0)) + +(declaim (ftype (function (uuid uuid) boolean) uuid=)) +(defun uuid= (x y) + (or (eq x y) + (and (eql (time-low x) (time-low y)) + (eql (time-mid x) (time-mid y)) + (eql (time-hi-and-version x) (time-hi-and-version y)) + (eql (clock-seq-hi-and-res x) (clock-seq-hi-and-res y)) + (eql (clock-seq-low x) (clock-seq-low y)) + (eql (node x) (node y))))) + +(defun uuid-equal-p (x y) + (or (eq x y) + (and x y + (let ((x (if (stringp x) + (from-string x) + x)) + (y (if (stringp y) + (from-string y) + y))) + (uuid= x y))))) diff --git a/package.lisp b/package.lisp new file mode 100644 index 0000000..ca260c7 --- /dev/null +++ b/package.lisp @@ -0,0 +1,16 @@ +;;;; package.lisp + +(defpackage #:frugal-uuid + (:nicknames #:fuuid) + (:use #:cl) + (:export #:uuid + #:from-integer + #:to-integer + #:from-string + #:to-string + #:make-nil + #:uuid= + #:uuid-equal-p + + ;; Version 4 + #:make-v4))