steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

cbor: read bignums, read/write timestamps and urls.

clean-linux-x86-64
John Benediktsson 2019-08-20 14:48:03 -07:00
parent 56fbf4643d
commit 336da664ba
2 changed files with 26 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
extra/cbor/cbor-tests.factor
View File

@ -1,5 +1,5 @@
USING: arrays cbor literals math math.parser math.ranges
tools.test ;
USING: arrays calendar cbor literals math math.parser
math.ranges tools.test urls ;
{ 500 } [ B{ 0b000,11001 0x01 0xf4 } cbor> ] unit-test
@ -56,12 +56,12 @@ tools.test ;
{ T{ cbor-simple f 16 } } [ B{ 0xf0 } cbor> ] unit-test
{ T{ cbor-simple f 24 } } [ B{ 0xf8 0x18 } cbor> ] unit-test
{ T{ cbor-simple f 255 } } [ B{ 0xf8 0xff } cbor> ] unit-test
{ T{ cbor-tagged f 0 "2013-03-21T20:04:00Z" } } [ "c074323031332d30332d32315432303a30343a30305a" hex-string>bytes cbor> ] unit-test
{ T{ cbor-tagged f 1 1363896240 } } [ "c11a514b67b0" hex-string>bytes cbor> ] unit-test
{ T{ cbor-tagged f 1 1363896240.5 } } [ "c1fb41d452d9ec200000" hex-string>bytes cbor> ] unit-test
{ T{ timestamp { year 2013 } { month 3 } { day 21 } { hour 20 } { minute 4 } } } [ "c074323031332d30332d32315432303a30343a30305a" hex-string>bytes cbor> ] unit-test
{ T{ timestamp { year 2013 } { month 3 } { day 21 } { hour 20 } { minute 4 } } } [ "c11a514b67b0" hex-string>bytes cbor> ] unit-test
{ T{ timestamp { year 2013 } { month 3 } { day 21 } { hour 20 } { minute 4 } { second 0.5 } } } [ "c1fb41d452d9ec200000" hex-string>bytes cbor> ] unit-test
{ T{ cbor-tagged f 23 B{ 0x01 0x02 0x03 0x04 } } } [ "d74401020304" hex-string>bytes cbor> ] unit-test
{ T{ cbor-tagged f 24 B{ 0x64 0x49 0x45 0x54 0x46 } } } [ "d818456449455446" hex-string>bytes cbor> ] unit-test
{ T{ cbor-tagged f 32 "http://www.example.com" } } [ "d82076687474703a2f2f7777772e6578616d706c652e636f6d" hex-string>bytes cbor> ] unit-test
{ URL" http://www.example.com" } [ "d82076687474703a2f2f7777772e6578616d706c652e636f6d" hex-string>bytes cbor> ] unit-test
{ B{ } } [ B{ 0x40 } cbor> ] unit-test
{ B{ 1 2 3 4 } } [ B{ 0x44 0x01 0x02 0x03 0x04 } cbor> ] unit-test
{ "" } [ B{ 0x60 } cbor> ] unit-test

25
extra/cbor/cbor.factor
View File

@ -1,10 +1,11 @@
! Copyright (C) 2019 John Benediktsson
! See http://factorcode.org/license.txt for BSD license
USING: accessors arrays assocs byte-arrays combinators io
io.binary io.encodings.binary io.encodings.string
io.encodings.utf8 io.streams.byte-array io.streams.string kernel
math math.bitwise math.floats.half sequences strings ;
USING: accessors arrays assocs base64 byte-arrays calendar
calendar.format calendar.parser combinators io io.binary
io.encodings.binary io.encodings.string io.encodings.utf8
io.streams.byte-array io.streams.string kernel math math.bitwise
math.floats.half present sequences strings urls ;
IN: cbor
@ -61,7 +62,15 @@ TUPLE: cbor-simple value ;
] if ;
: read-tagged ( info -- tagged )
read-unsigned read-cbor cbor-tagged boa ;
read-unsigned read-cbor swap {
{ 0 [ rfc3339>timestamp ] }
{ 1 [ unix-time>timestamp ] }
{ 2 [ be> ] }
{ 3 [ be> neg 1 - ] }
{ 32 [ >url ] }
{ 33 [ base64> ] }
[ swap cbor-tagged boa ]
} case ;
: read-float ( info -- float )
dup 20 < [ cbor-simple boa ] [
@ -133,6 +142,12 @@ M: sequence write-cbor
M: assoc write-cbor
dup length 5 write-integer [ [ write-cbor ] bi@ ] assoc-each ;
M: timestamp write-cbor
0 6 write-integer timestamp>rfc3339 write-cbor ;
M: url write-cbor
32 6 write-integer present write-cbor ;
M: cbor-tagged write-cbor
dup tag>> 6 write-integer item>> write-cbor ;