From f7abccc38ceda7024ca375d34ed88f4fb561ef02 Mon Sep 17 00:00:00 2001 From: colin Date: Sun, 5 Mar 2023 16:36:44 -0800 Subject: Reorganized codebase --- src/utilities.lisp | 68 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 68 insertions(+) create mode 100644 src/utilities.lisp (limited to 'src/utilities.lisp') diff --git a/src/utilities.lisp b/src/utilities.lisp new file mode 100644 index 0000000..1e16931 --- /dev/null +++ b/src/utilities.lisp @@ -0,0 +1,68 @@ +;;;; utilities -- nuff said + +(in-package :dnd) + + +(let ((host (uiop:hostname)) + (count 0)) + (defun nuid () + "Generates a Nearly Universal ID" + (format nil "~36r" + (sxhash + (list + (incf count) + host + (get-universal-time)))))) + +(defun hash-string (plaintext salt) + "Hash plaintext using SALT" + (flexi-streams:octets-to-string + (ironclad:digest-sequence + :sha3 + (flexi-streams:string-to-octets (concatenate 'string salt plaintext) + :external-format :utf-8)) + :external-format :latin1)) + +(defparameter +user-nick-chars+ "0123456789abcdefghijklmnopqrstuvwxyz-._") + +(defun/t valid-nick-p (nick) + :tests + (eql ("??????") nil) + (eql ("⚔") nil) + (eql ("cool_beans") t) + (eql ("COOOL_BEANS") t) + (eql ("COOL beans") nil) + :end + (unless (zerop (length nick)) + (loop :for char :across nick + :always (find char +user-nick-chars+ + :test #'char-equal)))) + +(defun/t asciip (thing) + "T if THING is an ASCII character, NIL otherwise." + :tests + (eql (#\x) t) + (eql (#\ö) nil) + (eql (#\nul) t) + (eql (#\return) t) + (eql (nil) nil) + (eql ("foo") nil) + :end + (and (characterp thing) + (<= 0 (char-code thing) 127))) + +(defun/t urlify (string &optional (sub #\-)) + "Canonical transformation for strings that makes them appropriate for urls." + :tests + (equal ("THIS IS COOL") "this-is-cool") + (equal ("This is cool") "this-is-cool") + (equal ("Mc'this is κoöl ") "mc-this-is-o-l") + :end + (str:join + sub + (str:split-omit-nulls + #\space + (substitute-if-not + #\space + (a:conjoin #'asciip #'alphanumericp) + (string-downcase string))))) -- cgit v1.2.3