diff --git a/extra/msgpack/authors.txt b/extra/msgpack/authors.txt new file mode 100644 index 0000000000..e091bb8164 --- /dev/null +++ b/extra/msgpack/authors.txt @@ -0,0 +1 @@ +John Benediktsson diff --git a/extra/msgpack/msgpack-tests.factor b/extra/msgpack/msgpack-tests.factor new file mode 100644 index 0000000000..9fe57b32d9 --- /dev/null +++ b/extra/msgpack/msgpack-tests.factor @@ -0,0 +1,55 @@ +USING: io.streams.string kernel math sequences tools.test ; + +IN: msgpack + +{ + { + +msgpack-nil+ + f + t + -1 + -31 + 128 + -1152921504606846976 + 1.5 + 1.23434536 + "hello" + { 1 1234 123456789 } + H{ { 1 "hello" } { 2 "goodbye" } } + } +} [ + + { + "\xc0" + "\xc2" + "\xc3" + "\xff" + "\xe1" + "\xcc\x80" + "\xd3\xf0\x00\x00\x00\x00\x00\x00\x00" + "\xcb?\xf8\x00\x00\x00\x00\x00\x00" + "\xcb?\xf3\xbf\xe0\xeb\x92\xb5\xa5" + "\xa5hello" + "\x93\x01\xcd\x04\xd2\xce\x07[\xcd\x15" + "\x82\x01\xa5hello\x02\xa7goodbye" + } [ msgpack> ] map +] unit-test + +{ t } [ + { + +msgpack-nil+ + f + t + -1 + -31 + 128 + -1152921504606846976 + 1.5 + 1.23434536 + "hello" + { 1 1234 123456789 } + H{ { 1 "hello" } { 2 "goodbye" } } + } [ dup >msgpack msgpack> = ] all? +] unit-test + +[ 64 2^ >msgpack ] [ cannot-convert? ] must-fail-with diff --git a/extra/msgpack/msgpack.factor b/extra/msgpack/msgpack.factor new file mode 100644 index 0000000000..57870bc364 --- /dev/null +++ b/extra/msgpack/msgpack.factor @@ -0,0 +1,157 @@ +! Copyright (C) 2013 John Benediktsson +! See http://factorcode.org/license.txt for BSD license + +USING: arrays assocs byte-arrays byte-vectors combinators +grouping hashtables io io.binary io.streams.string kernel math +math.bitwise math.order sbufs sequences strings ; + +IN: msgpack + +DEFER: read-msgpack + +hashtable ; + +: read-ext ( n -- obj ) + read be> [ 1 read signed-be> ] dip read 2array ; + +PRIVATE> + +SINGLETON: +msgpack-nil+ + +ERROR: unknown-format n ; + +: read-msgpack ( -- obj ) + read1 { + { [ dup 0xc0 = ] [ drop +msgpack-nil+ ] } + { [ dup 0xc2 = ] [ drop f ] } + { [ dup 0xc3 = ] [ drop t ] } + { [ dup 0x00 0x7f between? ] [ ] } + { [ dup 0xe0 mask? ] [ 1array signed-be> ] } + { [ dup 0xcc = ] [ drop read1 ] } + { [ dup 0xcd = ] [ drop 2 read be> ] } + { [ dup 0xce = ] [ drop 4 read be> ] } + { [ dup 0xcf = ] [ drop 8 read be> ] } + { [ dup 0xd0 = ] [ drop 1 read signed-be> ] } + { [ dup 0xd1 = ] [ drop 2 read signed-be> ] } + { [ dup 0xd2 = ] [ drop 4 read signed-be> ] } + { [ dup 0xd3 = ] [ drop 8 read signed-be> ] } + { [ dup 0xca = ] [ drop 4 read be> bits>float ] } + { [ dup 0xcb = ] [ drop 8 read be> bits>double ] } + { [ dup 0xe0 mask 0xa0 = ] [ 0x1f mask read ] } + { [ dup 0xd9 = ] [ drop read1 read "" like ] } + { [ dup 0xda = ] [ drop 2 read be> read "" like ] } + { [ dup 0xdb = ] [ drop 4 read be> read "" like ] } + { [ dup 0xc4 = ] [ drop read1 read B{ } like ] } + { [ dup 0xc5 = ] [ drop 2 read be> read B{ } like ] } + { [ dup 0xc6 = ] [ drop 4 read be> read B{ } like ] } + { [ dup 0xf0 mask 0x90 = ] [ 0x0f mask read-array ] } + { [ dup 0xdc = ] [ drop 2 read be> read-array ] } + { [ dup 0xdd = ] [ drop 4 read be> read-array ] } + { [ dup 0xf0 mask 0x80 = ] [ 0x0f mask read-map ] } + { [ dup 0xde = ] [ drop 2 read be> read-map ] } + { [ dup 0xdf = ] [ drop 4 read be> read-map ] } + { [ dup 0xd4 = ] [ drop 1 read-ext ] } + { [ dup 0xd5 = ] [ drop 2 read-ext ] } + { [ dup 0xd6 = ] [ drop 4 read-ext ] } + { [ dup 0xd7 = ] [ drop 8 read-ext ] } + { [ dup 0xd8 = ] [ drop 16 read-ext ] } + { [ dup 0xc7 = ] [ drop read1 read-ext ] } + { [ dup 0xc8 = ] [ drop 2 read be> read-ext ] } + { [ dup 0xc9 = ] [ drop 4 read be> read-ext ] } + [ unknown-format ] + } cond ; + +ERROR: cannot-convert obj ; + +GENERIC: write-msgpack ( obj -- ) + += [ + { + { [ dup 0x7f <= ] [ write1 ] } + { [ dup 0xff <= ] [ 0xcc write1 1 >be write ] } + { [ dup 0xffff <= ] [ 0xcd write1 2 >be write ] } + { [ dup 0xffffffff <= ] [ 0xce write1 4 >be write ] } + { [ dup 0xffffffffffffffff <= ] [ 0xcf write1 8 >be write ] } + [ cannot-convert ] + } cond + ] [ + { + { [ dup -0x1f >= ] [ 1 >be write ] } + { [ dup -0x80 >= ] [ 0xd0 write1 1 >be write ] } + { [ dup -0x8000 >= ] [ 0xd1 write1 2 >be write ] } + { [ dup -0x80000000 >= ] [ 0xd2 write1 4 >be write ] } + { [ dup -0x8000000000000000 >= ] [ 0xd3 write1 8 >be write ] } + [ cannot-convert ] + } cond + ] if ; + +M: float write-msgpack + 0xcb write1 double>bits 8 >be write ; + +: write-string ( obj -- ) + dup length { + { [ dup 0x1f <= ] [ 0xa0 bitor write1 write ] } + { [ dup 0xff <= ] [ 0xd9 write1 write1 write ] } + { [ dup 0xffff <= ] [ 0xda write1 2 >be write write ] } + { [ dup 0xffffffff <= ] [ 0xdb write1 4 >be write write ] } + [ cannot-convert ] + } cond ; + +M: string write-msgpack write-string ; +M: sbuf write-msgpack write-string ; + +: write-bytes ( obj -- ) + dup length { + { [ dup 0xff <= ] [ 0xc4 write1 write1 write ] } + { [ dup 0xffff <= ] [ 0xc5 write1 2 >be write write ] } + { [ dup 0xffffffff <= ] [ 0xc6 write1 4 >be write write ] } + [ cannot-convert ] + } cond ; + +M: byte-array write-msgpack write-bytes ; +M: byte-vector write-msgpack write-bytes ; + +: write-array ( obj -- ) + [ write-msgpack ] each ; inline + +: write-map ( obj -- ) + [ [ write-msgpack ] bi@ ] assoc-each ; inline + +M: sequence write-msgpack + dup length { + { [ dup 0xf <= ] [ 0x90 bitor write1 write-array ] } + { [ dup 0xffff <= ] [ 0xdc write1 2 >be write write-array ] } + { [ dup 0xffffffff <= ] [ 0xdd write1 4 >be write write-array ] } + [ cannot-convert ] + } cond ; + +M: assoc write-msgpack + dup assoc-size { + { [ dup 0xf <= ] [ 0x80 bitor write1 write-map ] } + { [ dup 0xffff <= ] [ 0xde write1 2 >be write write-map ] } + { [ dup 0xffffffff <= ] [ 0xdf write1 4 >be write write-map ] } + [ cannot-convert ] + } cond ; + +PRIVATE> + +: msgpack> ( string -- obj ) + [ read-msgpack ] with-string-reader ; + +: >msgpack ( obj -- string ) + [ write-msgpack ] with-string-writer ; diff --git a/extra/msgpack/summary.txt b/extra/msgpack/summary.txt new file mode 100644 index 0000000000..3bb5c63089 --- /dev/null +++ b/extra/msgpack/summary.txt @@ -0,0 +1 @@ +Support for msgpack protocol.