bech32: adding Bech32 and Bech32m encoding/decoding

diff --git a/extra/bech32/authors.txt b/extra/bech32/authors.txt
new file mode 100644 (file)
index 0000000..e091bb8
--- /dev/null
+++ b/extra/bech32/authors.txt
@@ -0,0 +1 @@
+John Benediktsson

diff --git a/extra/bech32/bech32-tests.factor b/extra/bech32/bech32-tests.factor
new file mode 100644 (file)
index 0000000..25c2962
--- /dev/null
+++ b/extra/bech32/bech32-tests.factor
@@ -0,0 +1,141 @@
+USING: bech32 tools.test ;
+
+! bech32
+
+{ "a" B{ } } [ "A12UEL5L" bech32> ] unit-test
+{ "a" B{ } } [ "a12uel5l" bech32> ] unit-test
+
+{
+    "an83characterlonghumanreadablepartthatcontainsthenumber1andtheexcludedcharactersbio"
+    B{ }
+} [
+    "an83characterlonghumanreadablepartthatcontainsthenumber1andtheexcludedcharactersbio1tt5tgs"
+    bech32>
+] unit-test
+
+{
+    "abcdef"
+    "\0\x01\x02\x03\x04\x05\x06\a\b\t\n\v\f\r\x0e\x0f\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\e\x1c\x1d\x1e\x1f"
+} [
+    "abcdef1qpzry9x8gf2tvdw0s3jn54khce6mua7lmqqqxw" bech32> "" like
+] unit-test
+
+{
+    "1"
+    "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0"
+} [
+    "11qqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqc8247j"
+    bech32> "" like
+] unit-test
+
+{
+    "split"
+    "\x18\x17\x19\x18\x16\x1c\x01\x10\v\x1d\b\x19\x17\x1d\x13\r\x10\x17\x1d\x16\x19\x1c\x01\x10\v\x03\x19\x1d\e\x19\x03\x03\x1d\x13\v\x19\x03\x03\x19\r\x18\x1d\x01\x19\x03\x03\x19\r"
+} [
+    "split1checkupstagehandshakeupstreamerranterredcaperred2y9e3w"
+    bech32> "" like
+] unit-test
+
+{
+    {
+        { f f }
+        { f f }
+        { f f }
+        { f f }
+        { f f }
+        { f f }
+        { f f }
+        { f f }
+        { f f }
+        { f f }
+        { f f }
+        { f f }
+    }
+} [
+    {
+        "\x201nwldj5"
+        "\x7f1axkwrx"
+        "\x801eym55h"
+        "an84characterslonghumanreadablepartthatcontainsthenumber1andtheexcludedcharactersbio1569pvx"
+        "pzry9x0s0muk"
+        "1pzry9x0s0muk"
+        "x1b4n0q5v"
+        "li1dgmt3"
+        "de1lg7wt"
+        "A1G7SGD8"
+        "10a06t8"
+        "1qzzfhee"
+    } [ bech32> 2array ] map
+] unit-test
+
+! bech32m
+
+{ "a" B{ } } [ "A1LQFN3A" bech32m> ] unit-test
+{ "a" B{ } } [ "a1lqfn3a" bech32m> ] unit-test
+
+{
+    "an83characterlonghumanreadablepartthatcontainsthetheexcludedcharactersbioandnumber1"
+    B{ }
+} [
+    "an83characterlonghumanreadablepartthatcontainsthetheexcludedcharactersbioandnumber11sg7hg6"
+    bech32m>
+] unit-test
+
+{
+    "abcdef"
+    "\x1f\x1e\x1d\x1c\e\x1a\x19\x18\x17\x16\x15\x14\x13\x12\x11\x10\x0f\x0e\r\f\v\n\t\b\a\x06\x05\x04\x03\x02\x01\0"
+} [
+    "abcdef1l7aum6echk45nj3s0wdvt2fg8x9yrzpqzd3ryx" bech32m> "" like
+] unit-test
+
+{
+    "1"
+    "\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f\x1f"
+} [
+    "11llllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllludsr8"
+    bech32m> "" like
+] unit-test
+
+{
+    "split"
+    "\x18\x17\x19\x18\x16\x1c\x01\x10\v\x1d\b\x19\x17\x1d\x13\r\x10\x17\x1d\x16\x19\x1c\x01\x10\v\x03\x19\x1d\e\x19\x03\x03\x1d\x13\v\x19\x03\x03\x19\r\x18\x1d\x01\x19\x03\x03\x19\r"
+} [
+    "split1checkupstagehandshakeupstreamerranterredcaperredlc445v"
+    bech32m> "" like
+] unit-test
+
+{
+    {
+        { f f }
+        { f f }
+        { f f }
+        { f f }
+        { f f }
+        { f f }
+        { f f }
+        { f f }
+        { f f }
+        { f f }
+        { f f }
+        { f f }
+        { f f }
+        { f f }
+    }
+} [
+    {
+        "\x201xj0phk"
+        "\x7f1g6xzxy"
+        "\x801vctc34"
+        "an84characterslonghumanreadablepartthatcontainsthetheexcludedcharactersbioandnumber11d6pts4"
+        "qyrz8wqd2c9m"
+        "1qyrz8wqd2c9m"
+        "y1b0jsk6g"
+        "lt1igcx5c0"
+        "in1muywd"
+        "mm1crxm3i"
+        "au1s5cgom"
+        "M1VUXWEZ"
+        "16plkw9"
+        "1p2gdwpf"
+    } [ bech32m> 2array ] map
+] unit-test

diff --git a/extra/bech32/bech32.factor b/extra/bech32/bech32.factor
new file mode 100644 (file)
index 0000000..631bc8f
--- /dev/null
+++ b/extra/bech32/bech32.factor
@@ -0,0 +1,69 @@
+
+USING: ascii byte-arrays combinators.short-circuit kernel
+literals math math.order sequences ;
+
+IN: bech32
+
+<PRIVATE
+
+CONSTANT: alphabet $[ "qpzry9x8gf2tvdw0s3jn54khce6mua7l" >byte-array ]
+
+: bech32-polymod ( values -- n )
+    1 [
+        over
+        [ 0x1ffffff bitand 5 shift ] [ bitxor ] [ -25 shift ] tri*
+        { 0x3b6a57b2 0x26508e6d 0x1ea119fa 0x3d4233dd 0x2a1462b3 } [
+            bit? [ bitxor ] [ drop ] if
+        ] with each-index
+    ] reduce ;
+
+: bech32-hrp-expand ( s -- t )
+    [ [ -5 shift ] map B{ 0 } ] [ [ 0x1f bitand ] map 3append ] bi ;
+
+: bech32-hrp-data ( hrp data -- seq )
+    [ bech32-hrp-expand ] [ append ] bi* ;
+
+: bech32-checksum? ( hrp data checksum -- ? )
+    [ bech32-hrp-data bech32-polymod ] [ = ] bi* ;
+
+: bech32-checksum ( hrp data checksum -- checksum )
+    [ bech32-hrp-data B{ 0 0 0 0 0 0 } append bech32-polymod ]
+    [ bitxor ] bi* 6 [
+       5 - 5 * shift 0x1f bitand
+    ] with B{ } map-integers-as ;
+
+: bech32-encode ( hrp data checksum -- bech32 )
+    [ dup ] 2dip over [ bech32-checksum ] [ prepend ] bi*
+    [ alphabet nth ] map "1" glue ;
+
+: bech32-decode ( bech32 checksum -- hrp data )
+    over {
+        [ [ 33 126 between? not ] any? ]
+        [ [ dup >lower = ] [ dup >upper = ] bi or not ]
+    } 1|| [ 2drop f f ] [
+        swap >lower CHAR: 1 over last-index {
+            [ dup not ]
+            [ dup 1 83 between? not ]
+            [ 2dup [ length ] [ 7 + ] bi* < ]
+        } 0|| [ 3drop f f ] [
+            cut rest [ alphabet index 0xff or ] B{ } map-as
+            dup [ 0xff = ] any? [ 3drop f f ] [
+                rot [ 2dup ] dip bech32-checksum?
+                [ 6 head* ] [ 2drop f f ] if
+            ] if
+        ] if
+    ] if ;
+
+PRIVATE>
+
+: >bech32 ( hrp data -- bech32 )
+    1 bech32-encode ;
+
+: bech32> ( bech32 -- hrp data )
+    1 bech32-decode ;
+
+: >bech32m ( hrp data -- bech32m )
+    0x2bc830a3 bech32-encode ;
+
+: bech32m> ( bech32 -- hrp data )
+    0x2bc830a3 bech32-decode ;

diff --git a/extra/bech32/summary.txt b/extra/bech32/summary.txt
new file mode 100644 (file)
index 0000000..59fd9bb
--- /dev/null
+++ b/extra/bech32/summary.txt
@@ -0,0 +1 @@
+Bech32 encoding/decoding