diff --git a/pkgs/anoia/Makefile b/pkgs/anoia/Makefile index 75f9021..a798959 100644 --- a/pkgs/anoia/Makefile +++ b/pkgs/anoia/Makefile @@ -2,8 +2,11 @@ servicedir:=$(shell mktemp -d) default: fs.lua init.lua nl.lua svc.lua net/constants.lua +CHECK=fs.fnl init.fnl svc.fnl + check: ln -s . anoia + fennel ./run-tests.fnl $(CHECK) fennel test.fnl fennel test-svc.fnl $(servicedir) test -f $(servicedir)/fish diff --git a/pkgs/anoia/init.fnl b/pkgs/anoia/init.fnl index b7d434c..530573b 100644 --- a/pkgs/anoia/init.fnl +++ b/pkgs/anoia/init.fnl @@ -1,3 +1,9 @@ +;; importing assert.fnl macros here would be circular, so we can't use +;; the full test functionality +(macro define-tests [& body] + (when _G.RUNNING_TESTS + `(do ,(unpack body)))) + (fn assoc [tbl k v & more] (tset tbl k v) (case more @@ -52,7 +58,7 @@ ;; there are no keys in b which are not also in a (and present (. a k)))))) -(comment +(define-tests (assert (table= {:a 1 :b 2} {:b 2 :a 1})) (assert (not (table= {:a 1 :b 2 :k :l} {:b 2 :a 1}))) (assert (not (table= {:a 1 :b 2} {:b 2 :a 1 :k :l}))) @@ -68,32 +74,32 @@ [el] (. tree el) [] tree)) -(local - base64-indices - (doto [ - "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "L" "M" "N" "O" "P" - "Q" "R" "S" "T" "U" "V" "W" "X" "Y" "Z" "a" "b" "c" "d" "e" "f" - "g" "h" "i" "j" "k" "l" "m" "n" "o" "p" "q" "r" "s" "t" "u" "v" - "w" "x" "y" "z" "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "-" "_" - ] - (tset 0 "A"))) - -;; local function base64(s) -;; local byte, rep = string.byte, string.rep -;; local pad = 2 - ((#s-1) % 3) -;; s = (s..rep('\0', pad)):gsub("...", function(cs) -;; local a, b, c = byte(cs, 1, 3) -;; return bs[a>>2] .. bs[(a&3)<<4|b>>4] .. bs[(b&15)<<2|c>>6] .. bs[c&63] -;; end) -;; return s:sub(1, #s-pad) .. rep('=', pad) -;; end - (fn %% [fmt ...] (string.format fmt ...)) -(fn base64url [s] - "URL-safe Base64-encoded form of s (no trailing padding)" +(local + base64-indices + (let [base [ + "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "L" "M" "N" "O" "P" + "Q" "R" "S" "T" "U" "V" "W" "X" "Y" "Z" "a" "b" "c" "d" "e" "f" + "g" "h" "i" "j" "k" "l" "m" "n" "o" "p" "q" "r" "s" "t" "u" "v" + "w" "x" "y" "z" "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" + ]] + { + :url + (merge (dup base) + { 0 "A" + 62 "-" + 63 "_" }) + :standard + (merge (dup base) + { 0 "A" + 62 "+" + 63 "/" }) + })) + + +(fn base64-encode [s bs] (let [pad (- 2 (% (- (# s) 1) 3)) - bs base64-indices blank (string.rep "\0" pad) s (-> (.. s blank) (: :gsub @@ -106,9 +112,71 @@ (. bs (band c 63)))))))] (s:sub 1 (- (# s) pad)))) +(fn base64-decode [input rindices] + ;; take groups of 4 characters, reverse-look them up in base64-indices, + ;; convert to 24 bit number, + ;; convert to three characters + (let [padding (if (= (string.sub input -2 -1) "==") -3 + (= (string.sub input -1 -1) "=") -2 + -1) + input (string.sub (.. input "===") 1 (* (/ (# input) 4) 4))] + (-> + (icollect [s (string.gmatch input "(....)")] + (let [(a b c d) (string.byte s 1 4) + ri (fn [x] (assert (. rindices x) (.. "invalid " x))) + n (bor (ri d) + (lshift (ri c) 6) + (lshift (ri b) 12) + (lshift (ri a) 18))] + + + (string.pack "bbb" + (rshift (band 0xff0000 n) 16) + (rshift (band 0x00ff00 n) 8) + (band 0x0000ff n)))) + (table.concat "") + (string.sub 1 padding) + ))) + +(fn base64 [alphabet-des] + (let [alphabet (or (. base64-indices alphabet-des) alphabet-des (. base64-indices :standard) ) + ralphabet (doto + (collect [k v (pairs alphabet)] + (values (string.byte v) k)) + (tset (string.byte "=") 0))] + { + :encode (fn [_ str] (base64-encode str alphabet)) + :decode (fn [_ str] (base64-decode str ralphabet)) + })) + +(fn base64url [str] (: (base64 :url) :encode str)) + + + +(define-tests + (let [{: view} (require :fennel) + b64 (base64 :url)] + + (let [a (b64:decode "YWxsIHlvdXIgYmFzZQ==")] + (assert (= a "all your base") (view a))) + (let [a (b64:decode "ZmVubmVsIHRoaW5n")] + (assert (= a "fennel thing") a)) + (let [a (b64:decode "TWFueSBoYW5kcyBtYWtlIGxpZ2h0IHdvcms=")] + (assert (= a "Many hands make light work") (view a))) + (let [a (b64:encode "hello world")] + (assert (= a "aGVsbG8gd29ybGQ") a)))) + + + ;; doesn't work if the padding is missing + ;; (let [a (from-base64 "TWFueSBoYW5kcyBtYWtlIGxpZ2h0IHdvcms")] + ;; (assert (= a "Many hands make light work") (view a))) +; )) + + { : assoc + : base64 : base64url : basename : dig