]> gitweb.factorcode.org Git - factor.git/commitdiff
http2: move briefly to extra/ due to dependency on io.streams.peek.
authorJohn Benediktsson <mrjbq7@gmail.com>
Wed, 5 May 2021 04:00:58 +0000 (21:00 -0700)
committerJohn Benediktsson <mrjbq7@gmail.com>
Wed, 5 May 2021 04:00:58 +0000 (21:00 -0700)
basis/http2/hpack/hpack-docs.factor [deleted file]
basis/http2/hpack/hpack-tests.factor [deleted file]
basis/http2/hpack/hpack.factor [deleted file]
basis/http2/hpack/huffman/huffman.factor [deleted file]
basis/http2/server/server.factor [deleted file]
extra/http2/hpack/hpack-docs.factor [new file with mode: 0644]
extra/http2/hpack/hpack-tests.factor [new file with mode: 0644]
extra/http2/hpack/hpack.factor [new file with mode: 0644]
extra/http2/hpack/huffman/huffman.factor [new file with mode: 0644]
extra/http2/server/server.factor [new file with mode: 0644]

diff --git a/basis/http2/hpack/hpack-docs.factor b/basis/http2/hpack/hpack-docs.factor
deleted file mode 100644 (file)
index f381726..0000000
+++ /dev/null
@@ -1,36 +0,0 @@
-! Copyright (C) 2021 Your name.
-! See http://factorcode.org/license.txt for BSD license.
-USING: byte-arrays help.markup help.syntax kernel sequences strings ;
-IN: http2.hpack
-
-HELP: hpack-context
-{ $class-description "Stores the context for a hpack decoder or encoder. This is primarily the current state of the dynamic table." } ;
-
-HELP: hpack-decode
-{ $values
-    { "decode-context" hpack-context } { "block" byte-array }
-    { "updated-context" hpack-context } { "decoded" sequence }
-}
-{ $description "Decodes the given byte array (or byte vector) in the given hpack context. Outputs the updated context, and the decoded header block as a sequence of pairs." } ;
-
-HELP: hpack-decode-error
-{ $values
-    { "error-msg" string }
-}
-{ $description "Throws a " { $link hpack-decode-error } " error." }
-{ $error-description "Thrown for any of the possible errors specified in RFC7541 for decoding hpack encoded byte strings." } ;
-
-HELP: hpack-encode
-{ $values
-    { "encode-context" hpack-context } { "headers" sequence }
-    { "updated-context" hpack-context } { "block" byte-array }
-}
-{ $description "Encodes the sequence of headers using the given context. Outputs the updated context and the encoded header block, as a byte array." } ;
-
-ARTICLE: "http2.hpack" "HTTP/2 HPACK"
-{ $vocab-link "http2.hpack" }
-;
-
-{ hpack-encode hpack-decode } related-words
-
-ABOUT: "http2.hpack"
diff --git a/basis/http2/hpack/hpack-tests.factor b/basis/http2/hpack/hpack-tests.factor
deleted file mode 100644 (file)
index c6e4a5c..0000000
+++ /dev/null
@@ -1,304 +0,0 @@
-! Copyright (C) 2021 Your name.
-! See http://factorcode.org/license.txt for BSD license.
-USING: tools.test http2.hpack http2.hpack.private accessors
-kernel sequences ;
-IN: http2.hpack.tests
-
-! constants are from RFC 7541, appendix C, various sections
-CONSTANT: c1  B{ 234 31 154 10 42 }
-CONSTANT: c21 B{ 0x40 0x0a 0x63 0x75 0x73 0x74 0x6f 0x6d 0x2d
-    0x6b 0x65 0x79 0x0d 0x63 0x75 0x73 0x74 0x6f 0x6d 0x2d
-    0x68 0x65 0x61 0x64 0x65 0x72 }
-CONSTANT: c22 B{ 0x04 0x0c 0x2f 0x73 0x61 0x6d 0x70 0x6c 0x65
-    0x2f 0x70 0x61 0x74 0x68 }
-CONSTANT: c23 B{ 0x10 0x08 0x70 0x61 0x73 0x73 0x77 0x6f 0x72
-    0x64 0x06 0x73 0x65 0x63 0x72 0x65 0x74 }
-CONSTANT: c24 B{ 0x82 }
-
-CONSTANT: c31 B{ 0x82 0x86 0x84 0x41 0x0f 0x77 0x77 0x77 0x2e
-    0x65 0x78 0x61 0x6d 0x70 0x6c 0x65 0x2e 0x63 0x6f 0x6d }
-CONSTANT: c32 B{ 0x82 0x86 0x84 0xbe 0x58 0x08 0x6e 0x6f 0x2d
-    0x63 0x61 0x63 0x68 0x65 }
-CONSTANT: c33 B{ 0x82 0x87 0x85 0xbf 0x40 0x0a 0x63 0x75 0x73
-    0x74 0x6f 0x6d 0x2d 0x6b 0x65 0x79 0x0c 0x63 0x75 0x73
-    0x74 0x6f 0x6d 0x2d 0x76 0x61 0x6c 0x75 0x65 }
-
-CONSTANT: c41 B{ 0x82 0x86 0x84 0x41 0x8c 0xf1 0xe3 0xc2 0xe5
-    0xf2 0x3a 0x6b 0xa0 0xab 0x90 0xf4 0xff }
-CONSTANT: c42 B{ 0x82 0x86 0x84 0xbe 0x58 0x86 0xa8 0xeb 0x10
-    0x64 0x9c 0xbf }
-CONSTANT: c43 B{ 0x82 0x87 0x85 0xbf 0x40 0x88 0x25 0xa8 0x49
-    0xe9 0x5b 0xa9 0x7d 0x7f 0x89 0x25 0xa8 0x49 0xe9 0x5b
-    0xb8 0xe8 0xb4 0xbf }
-
-! These headers are the same as those for section 4
-CONSTANT: c31h { { ":method" "GET" } { ":scheme" "http" }
-    { ":path" "/" } { ":authority" "www.example.com" } }
-CONSTANT: c32h { { ":method" "GET" } { ":scheme" "http" }
-    { ":path" "/" } { ":authority" "www.example.com" } 
-    { "cache-control" "no-cache" } }
-CONSTANT: c33h { { ":method" "GET" } { ":scheme" "https" }
-    { ":path" "/index.html" } { ":authority" "www.example.com" } 
-    { "custom-key" "custom-value" } }
-
-CONSTANT: c51 B{ 0x48 0x03 0x33 0x30 0x32 0x58 0x07 0x70 0x72
-0x69 0x76 0x61 0x74 0x65 0x61 0x1d 0x4d 0x6f 0x6e 0x2c 0x20 0x32
-0x31 0x20 0x4f 0x63 0x74 0x20 0x32 0x30 0x31 0x33 0x20 0x32
-0x30 0x3a 0x31 0x33 0x3a 0x32 0x31 0x20 0x47 0x4d 0x54 0x6e
-0x17 0x68 0x74 0x74 0x70 0x73 0x3a 0x2f 0x2f 0x77 0x77 0x77
-0x2e 0x65 0x78 0x61 0x6d 0x70 0x6c 0x65 0x2e 0x63 0x6f 0x6d }
-CONSTANT: c52 B{ 0x48 0x03 0x33 0x30 0x37 0xc1 0xc0 0xbf }
-CONSTANT: c53 B{ 0x88 0xc1 0x61 0x1d 0x4d 0x6f 0x6e 0x2c 0x20
-0x32 0x31 0x20 0x4f 0x63 0x74 0x20 0x32 0x30 0x31 0x33 0x20 0x32
-0x30 0x3a 0x31 0x33 0x3a 0x32 0x32 0x20 0x47 0x4d 0x54 0xc0
-0x5a 0x04 0x67 0x7a 0x69 0x70 0x77 0x38 0x66 0x6f 0x6f 0x3d
-0x41 0x53 0x44 0x4a 0x4b 0x48 0x51 0x4b 0x42 0x5a 0x58 0x4f
-0x51 0x57 0x45 0x4f 0x50 0x49 0x55 0x41 0x58 0x51 0x57 0x45
-0x4f 0x49 0x55 0x3b 0x20 0x6d 0x61 0x78 0x2d 0x61 0x67 0x65
-0x3d 0x33 0x36 0x30 0x30 0x3b 0x20 0x76 0x65 0x72 0x73 0x69
-0x6f 0x6e 0x3d 0x31 }
-
-CONSTANT: c61 B{ 0x48 0x82 0x64 0x02 0x58 0x85 0xae 0xc3 0x77
-    0x1a 0x4b 0x61 0x96 0xd0 0x7a 0xbe 0x94 0x10 0x54 0xd4
-    0x44 0xa8 0x20 0x05 0x95 0x04 0x0b 0x81 0x66 0xe0 0x82 0xa6
-    0x2d 0x1b 0xff 0x6e 0x91 0x9d 0x29 0xad 0x17 0x18 0x63 0xc7
-    0x8f 0x0b 0x97 0xc8 0xe9 0xae 0x82 0xae 0x43 0xd3 }
-CONSTANT: c62 B{ 0x48 0x83 0x64 0x0e 0xff 0xc1 0xc0 0xbf }
-CONSTANT: c63 B{ 0x88 0xc1 0x61 0x96 0xd0 0x7a 0xbe 0x94 0x10
-    0x54 0xd4 0x44 0xa8 0x20 0x05 0x95 0x04 0x0b 0x81 0x66
-    0xe0 0x84 0xa6 0x2d 0x1b 0xff 0xc0 0x5a 0x83 0x9b 0xd9 0xab
-    0x77 0xad 0x94 0xe7 0x82 0x1d 0xd7 0xf2 0xe6 0xc7 0xb3 0x35
-    0xdf 0xdf 0xcd 0x5b 0x39 0x60 0xd5 0xaf 0x27 0x08 0x7f 0x36
-    0x72 0xc1 0xab 0x27 0x0f 0xb5 0x29 0x1f 0x95 0x87 0x31 0x60
-    0x65 0xc0 0x03 0xed 0x4e 0xe5 0xb1 0x06 0x3d 0x50 0x07 }
-
-! These headers are the same as those for section 6
-CONSTANT: c51h { { ":status" "302" }
-    { "cache-control" "private" }
-    { "date" "Mon, 21 Oct 2013 20:13:21 GMT" }
-    { "location" "https://www.example.com" } }
-CONSTANT: c52h { { ":status" "307" }
-    { "cache-control" "private" }
-    { "date" "Mon, 21 Oct 2013 20:13:21 GMT" }
-    { "location" "https://www.example.com" } }
-CONSTANT: c53h { { ":status" "200" }
-    { "cache-control" "private" }
-    { "date" "Mon, 21 Oct 2013 20:13:22 GMT" }
-    { "location" "https://www.example.com" }
-    { "content-encoding" "gzip" }
-    { "set-cookie" "foo=ASDJKHQKBZXOQWEOPIUAXQWEOIU; max-age=3600; version=1" } }
-
-
-! tests come from RFC 7541, Appendix C
-
-! RFC7541 Appendex C.1
-{ 1   10 } [ c1 0 5 decode-integer nipd ] unit-test
-{ 4 1337 } [ c1 1 5 decode-integer nipd ] unit-test
-{ 5   42 } [ c1 4 8 decode-integer nipd ] unit-test
-
-
-! RFC7541 Appendix C.2.1 subset
-{ 12 "custom-key" }
-[ c21 1 decode-string nipd ] unit-test
-
-! RFC7541 Appendix C.4.3 subset
-{ 24 "custom-value" }
-[ c43 14 decode-string nipd ] unit-test
-
-! RFC7541 Appendix C.2.1
-{ T{ hpack-context f 4096 { { "custom-key" "custom-header" } } } 
-   26 { "custom-key" "custom-header" } }
-[ hpack-context new c21 0 decode-field nipd ] unit-test
-
-! RFC7541 Appendix C.2.2
-{ T{ hpack-context f 4096 { } }  14 { ":path" "/sample/path" } }
-[ hpack-context new c22 0 decode-field nipd ] unit-test
-
-! RFC7541 Appendix C.2.3
-{ T{ hpack-context f 4096 { } } 17 { "password" "secret" } }
-[ hpack-context new c23 0 decode-field nipd ] unit-test
-
-! RFC7541 Appendix C.2.4
-{ T{ hpack-context f 4096 { } } 1 { ":method" "GET" } }
-[ hpack-context new c24 0 decode-field nipd ] unit-test
-
-
-! RFC7541 Appendix C.3
-{
-    { { ":method" "GET" } { ":scheme" "http" }
-        { ":path" "/" } { ":authority" "www.example.com" } }
-    { { ":method" "GET" } { ":scheme" "http" }
-        { ":path" "/" } { ":authority" "www.example.com" } 
-        { "cache-control" "no-cache" } }
-    { { ":method" "GET" } { ":scheme" "https" }
-        { ":path" "/index.html" } { ":authority" "www.example.com" } 
-        { "custom-key" "custom-value" } }
-    T{ hpack-context f 4096 { { "custom-key" "custom-value" }
-                                { "cache-control" "no-cache" }
-                                { ":authority" "www.example.com" } } }
-}
-[ hpack-context new c31 c32 c33 [ hpack-decode swap ] tri@ ] unit-test
-
-! RFC7541 Appendix C.4
-{
-    { { ":method" "GET" } { ":scheme" "http" }
-        { ":path" "/" } { ":authority" "www.example.com" } }
-    { { ":method" "GET" } { ":scheme" "http" }
-        { ":path" "/" } { ":authority" "www.example.com" } 
-        { "cache-control" "no-cache" } }
-    { { ":method" "GET" } { ":scheme" "https" }
-        { ":path" "/index.html" } { ":authority" "www.example.com" } 
-        { "custom-key" "custom-value" } }
-    T{ hpack-context f 4096 { { "custom-key" "custom-value" }
-                                { "cache-control" "no-cache" }
-                                { ":authority" "www.example.com" } } }
-}
-[ hpack-context new c41 c42 c43 [ hpack-decode swap ] tri@ ] unit-test
-
-! RFC7541 Appendix C.5
-{
-    {
-        { ":status" "302" }
-        { "cache-control" "private" }
-        { "date" "Mon, 21 Oct 2013 20:13:21 GMT" }
-        { "location" "https://www.example.com" }
-    }
-    {
-        { ":status" "307" }
-        { "cache-control" "private" }
-        { "date" "Mon, 21 Oct 2013 20:13:21 GMT" }
-        { "location" "https://www.example.com" }
-    }
-    {
-        { ":status" "200" }
-        { "cache-control" "private" }
-        { "date" "Mon, 21 Oct 2013 20:13:22 GMT" }
-        { "location" "https://www.example.com" }
-        { "content-encoding" "gzip" }
-        { "set-cookie" "foo=ASDJKHQKBZXOQWEOPIUAXQWEOIU; max-age=3600; version=1" }
-    }
-    T{ hpack-context f 256 { { "set-cookie" "foo=ASDJKHQKBZXOQWEOPIUAXQWEOIU; max-age=3600; version=1" }
-                             { "content-encoding" "gzip" }
-                             { "date" "Mon, 21 Oct 2013 20:13:22 GMT" } } }
-}
-[ hpack-context new 256 >>max-size c51 c52 c53
-    [ hpack-decode swap ] tri@ ] unit-test
-
-! RFC7541 Appendix C.6
-{
-    {
-        { ":status" "302" }
-        { "cache-control" "private" }
-        { "date" "Mon, 21 Oct 2013 20:13:21 GMT" }
-        { "location" "https://www.example.com" }
-    }
-    {
-        { ":status" "307" }
-        { "cache-control" "private" }
-        { "date" "Mon, 21 Oct 2013 20:13:21 GMT" }
-        { "location" "https://www.example.com" }
-    }
-    {
-        { ":status" "200" }
-        { "cache-control" "private" }
-        { "date" "Mon, 21 Oct 2013 20:13:22 GMT" }
-        { "location" "https://www.example.com" }
-        { "content-encoding" "gzip" }
-        { "set-cookie" "foo=ASDJKHQKBZXOQWEOPIUAXQWEOIU; max-age=3600; version=1" }
-    }
-    T{ hpack-context f 256 { { "set-cookie" "foo=ASDJKHQKBZXOQWEOPIUAXQWEOIU; max-age=3600; version=1" }
-                             { "content-encoding" "gzip" }
-                             { "date" "Mon, 21 Oct 2013 20:13:22 GMT" } } }
-}
-[ hpack-context new 256 >>max-size c61 c62 c63
-    [ hpack-decode swap ] tri@ ] unit-test
-
-
-! encoding can be tested primarily by ensuring the encoding and
-! decoding of an object yields the same object (since encoding
-! does not have a well defined output other then `decodable').
-
-
-! integer and string encoding tests
-{ B{ 0b00101010 } } [ 0b00100000 10 5 encode-integer ] unit-test
-{ B{ 0b01011111 0b10011010 0b00001010 } } [ 0b01000000 1337 5 encode-integer ] unit-test
-{ B{ 0b00101010 } } [ 0b00000000 42 8 encode-integer ] unit-test
-
-{ B{ 0x0a 0x63 0x75 0x73 0x74 0x6f 0x6d 0x2d 0x6b 0x65 0x79 } }
-[ "custom-key" encode-string-raw ] unit-test
-
-{ B{ 0x88 0x25 0xa8 0x49 0xe9 0x5b 0xa9 0x7d 0x7f } }
-[ "custom-key" encode-string-huffman ] unit-test
-
-
-! single header encoding check, mirrors the tests from RFC 7541, Appendix C.2
-{ t t { "custom-key" "custom-header" } }
-[ hpack-context new { "custom-key" "custom-header" } encode-field 
-  hpack-context new swap 0 decode-field 
-  [ [ = ] [ swap length = ] 2bi* ] dip ! check contexts are the same and the entire block used for decoding 
-] unit-test
-
-{ t t { ":path" "/sample/path" } }
-[ hpack-context new { ":path" "/sample/path" } encode-field 
-  hpack-context new swap 0 decode-field 
-  [ [ = ] [ swap length = ] 2bi* ] dip ! check contexts are the same and the entire block used for decoding 
-] unit-test
-
-{ t t { "password" "secret" } }
-[ hpack-context new { "password" "secret" } encode-field 
-  hpack-context new swap 0 decode-field 
-  [ [ = ] [ swap length = ] 2bi* ] dip ! check contexts are the same and the entire block used for decoding 
-] unit-test
-
-{ t t { ":method" "GET" } }
-[ hpack-context new { ":method" "GET" } encode-field 
-  hpack-context new swap 0 decode-field 
-  [ [ = ] [ swap length = ] 2bi* ] dip ! check contexts are the same and the entire block used for decoding 
-] unit-test
-
-
-! many header encoding check, using same values from RFC7541 Appendix C.3 and C.5
-{
-    { { ":method" "GET" } { ":scheme" "http" }
-        { ":path" "/" } { ":authority" "www.example.com" } }
-    { { ":method" "GET" } { ":scheme" "http" }
-        { ":path" "/" } { ":authority" "www.example.com" } 
-        { "cache-control" "no-cache" } }
-    { { ":method" "GET" } { ":scheme" "https" }
-        { ":path" "/index.html" } { ":authority" "www.example.com" } 
-        { "custom-key" "custom-value" } }
-    t
-}
-[ hpack-context new c31h c32h c33h [ hpack-encode swap ] tri@ 
-  [ [ hpack-context new ] 3dip [ hpack-decode swap ] tri@ ] dip
-  = ! check that the encode and decode contexts are identical
-] unit-test
-
-{
-    {
-        { ":status" "302" }
-        { "cache-control" "private" }
-        { "date" "Mon, 21 Oct 2013 20:13:21 GMT" }
-        { "location" "https://www.example.com" }
-    }
-    {
-        { ":status" "307" }
-        { "cache-control" "private" }
-        { "date" "Mon, 21 Oct 2013 20:13:21 GMT" }
-        { "location" "https://www.example.com" }
-    }
-    {
-        { ":status" "200" }
-        { "cache-control" "private" }
-        { "date" "Mon, 21 Oct 2013 20:13:22 GMT" }
-        { "location" "https://www.example.com" }
-        { "content-encoding" "gzip" }
-        { "set-cookie" "foo=ASDJKHQKBZXOQWEOPIUAXQWEOIU; max-age=3600; version=1" }
-    }
-    t
-}
-[ hpack-context new c51h c52h c53h [ hpack-encode swap ] tri@ 
-  [ [ hpack-context new ] 3dip [ hpack-decode swap ] tri@ ] dip
-  = ! check that the encode and decode contexts are identical
-] unit-test
-
diff --git a/basis/http2/hpack/hpack.factor b/basis/http2/hpack/hpack.factor
deleted file mode 100644 (file)
index 5fbfad5..0000000
+++ /dev/null
@@ -1,281 +0,0 @@
-USING: accessors arrays byte-arrays byte-vectors combinators fry
-http2.hpack.huffman io.encodings.string io.encodings.utf8 locals
-kernel math math.functions math.bitwise multiline sequences ;
-
-IN: http2.hpack
-
-TUPLE: hpack-context
-    { max-size integer initial: 4096 } { dynamic-table initial: { } } ;
-    ! default the max size to 4096 according to RFC7540
-
-ERROR: hpack-decode-error error-msg ;
-
-<PRIVATE
-
-! The static table for hpack compression/decompression,
-! from RFC 7541, Appendix A.
-CONSTANT: static-table {
-    { f f } ! allows indexing to work out properly
-    { ":authority" f }
-    { ":method" "GET" }
-    { ":method" "POST" }
-    { ":path" "/" }
-    { ":path" "/index.html" }
-    { ":scheme" "http" }
-    { ":scheme" "https" }
-    { ":status" "200" }
-    { ":status" "204" }
-    { ":status" "206" }
-    { ":status" "304" }
-    { ":status" "400" }
-    { ":status" "404" }
-    { ":status" "500" }
-    { "accept-charset" f }
-    { "accept-encoding" "gzip, deflate" }
-    { "accept-language" f }
-    { "accept-ranges" f }
-    { "accept" f }
-    { "access-control-allow-origin" f }
-    { "age" f }
-    { "allow" f }
-    { "authorization" f }
-    { "cache-control" f }
-    { "content-disposition" f }
-    { "content-encoding" f }
-    { "content-language" f }
-    { "content-length" f }
-    { "content-location" f }
-    { "content-range" f }
-    { "content-type" f }
-    { "cookie" f }
-    { "date" f }
-    { "etag" f }
-    { "expect" f }
-    { "expires" f }
-    { "from" f }
-    { "host" f }
-    { "if-match" f }
-    { "if-modified-since" f }
-    { "if-none-match" f }
-    { "if-range" f }
-    { "if-unmodified-since" f }
-    { "last-modified" f }
-    { "link" f }
-    { "location" f }
-    { "max-forwards" f }
-    { "proxy-authenticate" f }
-    { "proxy-authorization" f }
-    { "range" f }
-    { "referer" f }
-    { "refresh" f }
-    { "retry-after" f }
-    { "server" f }
-    { "set-cookie" f }
-    { "strict-transport-security" f }
-    { "transfer-encoding" f }
-    { "user-agent" f }
-    { "vary" f }
-    { "via" f }
-    { "www-authenticate" f }
-}
-
-: header-size ( header -- size )
-    sum-lengths 32 +
-    ;
-
-! gives the index in the dynamic table such that the sum of the
-! size of the elements before the index is less than or equal to
-! the desired-size, or f if no entries need to be removed to
-! attain the desired size
-:: dynamic-table-remove-index ( dynamic-table desired-size -- i/f )
-    0 dynamic-table [ header-size + dup desired-size >= ] find drop nip
-    ;
-
-! shrinks the dynamic table size to the given size (size, *not*
-! length) (doesn't affect the max-size of the context)
-: shrink-dynamic-table ( dynamic-table shrink-to -- shrunk-dynamic-table )
-    dupd dynamic-table-remove-index [ head ] when*
-    ;
-
-:: add-header-to-table ( hpack-context header -- updated-context )
-    hpack-context dynamic-table>> hpack-context max-size>>
-    header header-size - shrink-dynamic-table
-    header header-size hpack-context max-size>> <= [ header prefix ] when
-    hpack-context swap >>dynamic-table
-    ;
-
-: set-dynamic-table-size ( hpack-context new-size -- updated-decode-context )
-    [ >>max-size ] keep
-    [ dup dynamic-table>> ] dip shrink-dynamic-table >>dynamic-table
-    ;
-
-! check bounds: i < len(static-table++decode-context) and i > 0
-: check-index-bounds ( index decode-context -- )
-    [ drop 0 > ] [ dynamic-table>> length static-table length + < ] 2bi
-    and [ "invalid index given" hpack-decode-error ] unless ! if not valid throw error
-    ;
-
-: get-header-from-table ( hpack-context table-index -- field )
-    [ swap check-index-bounds ] 2keep
-    dup static-table length <  ! check if in static table
-    [ static-table nth nip ]
-    [ static-table length - swap dynamic-table>> nth ]
-    if ;
-
-: search-imperfect ( header table -- imperfect/f )
-    swap first '[ _ first = ] find drop
-    ;
-
-: search-given-table ( header table -- imperfect/f perfect/f )
-    [ search-imperfect ] [ index ] 2bi
-    ;
-
-: correct-dynamic-index ( dynamic-index/f -- whole-table-index/f )
-    [ static-table length + ] [ f ] if*
-    ;
-
-: search-static-table ( header -- imperfect/f perfect/f )
-    static-table search-given-table ;
-
-: search-dynamic-table ( header hpack-context --  imperfect/f perfect/f )
-    dynamic-table>> search-given-table
-    [ correct-dynamic-index ] bi@
-    ;
-
-: search-table ( header hpack-context -- imperfect/f perfect/f )
-    [ drop search-static-table ] [ search-dynamic-table ] 2bi
-    ! combine results from static and dynamic tables
-    swapd [ or ] 2bi@
-    ;
-
-
-! assumes the first-byte respects the prefix-length, such that
-! the last prefix-length bits are all 0.
-: encode-integer ( first-byte int prefix-length -- bytes )
-    2^ 1 - 2dup < 
-    [ drop bitor 1byte-array ]
-    [ swap over [ bitor 1byte-array >byte-vector ] [ - ] 2bi* 
-      [ dup 128 >= ] [ [ 128 mod 128 + over push ] [ 128 /i ] bi ]
-      while over push >byte-array
-    ] if ;
-
-! encodes a string without huffman encoding.
-: encode-string-raw ( string -- bytes )
-    utf8 encode
-    0 over length 7 encode-integer
-    prepend
-    ;
-
-: encode-string-huffman ( string -- bytes )
-    huffman-encode
-    128 over length 7 encode-integer
-    prepend
-    ;
-
-:: encode-field ( encode-context header -- updated-context block )
-    header encode-context search-table
-    [ 128 swap 7 encode-integer encode-context swap nipd ]
-    [ [ 64 swap 6 encode-integer ]
-      [ 64 0 6 encode-integer header first encode-string-huffman append
-        ] if* 
-        header second encode-string-huffman append
-        encode-context header add-header-to-table swap ]
-    if*
-    ;   
-
-! /*
-! version of decode integer that tries to be clever for less
-! stack stuff, but not sure if it actually is...
-:: decode-integer ( block current-index prefix-length -- block new-index number )
-    current-index 1 + :> end-index!
-    current-index block nth prefix-length 2^ 1 - [ mask ] keep over =
-    [
-        current-index 1 + block [ 7 bit? not ] find-from drop 1 + end-index!
-        current-index 1 + end-index block subseq reverse
-        0 [ 127 mask swap 128 * + ] reduce
-        +
-    ] when
-    [ block end-index ] dip ; ! */
-
-/*
-! initial version of decode-integer, which closely follows the
-! pseudocode from the rfc (RFC 7541, section 5.1)
-: decode-integer-fragment ( block index I M -- block index+1 I' M+7 block[index+1] )
-    ! increment index and get block[index]
-    [ 1 + 2dup swap nth ] 2dip
-    ! stack: block index+1 block[index+1] I M
-    ! compute I' = (block[index+1] & 127) * 2^M + I
-    pick 127 mask 2 pick ^ * '[ _ + ] dip
-    7 + rot ;
-
-: decode-integer ( block current-index prefix-length -- block new-index number )
-    ! get the current octet, compute mask, apply mask
-    [ 2dup swap nth ] dip 2^ 1 - [ mask ] keep
-    over = 
-    ! stack: block index I loop?
-    [ 0
-      [ 7 bit? ] [ decode-integer-fragment ] do while 
-      ! stack: block index I M, get rid of M, we don't need it
-      drop ]
-    when ! the prefix matches the mask (exactly all 1s), must loop
-    [ 1 + ] dip ! increment the index before return
-    ; ! */
-
-: decode-raw-string ( block current-index string-length -- block new-index string )
-    over + dup [ pick subseq utf8 decode ] dip swap ;
-
-: decode-huffman-string ( block current-index string-length -- block new-index string )
-    over + dup [ pick subseq huffman-decode ] dip swap 
-    ;
-
-: decode-string ( block current-index -- block new-index string )
-    [ 7 decode-integer ] [ swap nth 7 bit? ] 2bi
-    [ decode-huffman-string ] [ decode-raw-string ] if ; 
-
-: decode-literal-header ( decode-context block index index-length -- decode-context block new-index field )
-    decode-integer
-    ! string name if 0, else indexed
-    [ decode-string ] [ pickd get-header-from-table first ] if-zero
-    [ decode-string ] dip swap 2array
-    ;
-
-! block will be a byte array
-:: decode-field ( decode-context block index -- updated-context block new-index field/f )
-    decode-context block index
-    {
-        ! indexed header field
-        { [ index block nth 7 bit? ] [ 7 decode-integer 
-                decode-context swap get-header-from-table ] } 
-        ! Literal header field with incremental indexing
-        { [ index block nth 6 bit? ] [ 6 decode-literal-header 
-                [ 2nip add-header-to-table ] 3keep ] } 
-        ! dynamic table size update
-        { [ index block nth 5 bit? ] [ 5 decode-integer -rot f
-                [ set-dynamic-table-size ] 3dip ] }
-        ! literal header field without indexing
-        [ 4 decode-literal-header ]
-    } cond ;
-
-PRIVATE>
-
-! headers is a sequence of tuples represented the unencoded headers
-: hpack-encode ( encode-context headers -- updated-context block ) 
-    [ encode-field ] map concat ;
-
-
-! should give the updated dtable, and the list of decoded
-! header fields. block is the bytestring (byte array) for the header block
-: hpack-decode ( decode-context block -- updated-context decoded )
-    [let V{ } clone :> decoded-list
-    0 ! index in the block
-    [ 2dup swap length < ] ! check that the block is longer than the index
-    ! call decode-field and add the (possibly) decoded field to the list
-    [ decode-field [ decoded-list push ]
-                   [ decoded-list [ "Table size update not at start of header block"
-                   hpack-decode-error ] unless-empty ] if* ]
-    ! if the table was not empty, and we didn't get a header, throw an error.
-    while
-    2drop decoded-list >array
-    ! double check the header list size?
-    ] ;
-
diff --git a/basis/http2/hpack/huffman/huffman.factor b/basis/http2/hpack/huffman/huffman.factor
deleted file mode 100644 (file)
index 3344c92..0000000
+++ /dev/null
@@ -1,333 +0,0 @@
-USING: accessors arrays assocs bit-arrays http2.hpack
-io.encodings.string io.encodings.utf8 kernel literals locals
-make math sequences ;
-
-IN: http2.hpack.huffman
-
-<<
-! Table contents from RFC 7541 Appendix B
-CONSTANT: huffman-table {
-            {     0x1ff8  13 }
-            {   0x7fffd8  23 }
-            {  0xfffffe2  28 }
-            {  0xfffffe3  28 }
-            {  0xfffffe4  28 }
-            {  0xfffffe5  28 }
-            {  0xfffffe6  28 }
-            {  0xfffffe7  28 }
-            {  0xfffffe8  28 }
-            {   0xffffea  24 }
-            { 0x3ffffffc  30 }
-            {  0xfffffe9  28 }
-            {  0xfffffea  28 }
-            { 0x3ffffffd  30 }
-            {  0xfffffeb  28 }
-            {  0xfffffec  28 }
-            {  0xfffffed  28 }
-            {  0xfffffee  28 }
-            {  0xfffffef  28 }
-            {  0xffffff0  28 }
-            {  0xffffff1  28 }
-            {  0xffffff2  28 }
-            { 0x3ffffffe  30 }
-            {  0xffffff3  28 }
-            {  0xffffff4  28 }
-            {  0xffffff5  28 }
-            {  0xffffff6  28 }
-            {  0xffffff7  28 }
-            {  0xffffff8  28 }
-            {  0xffffff9  28 }
-            {  0xffffffa  28 }
-            {  0xffffffb  28 }
-            {       0x14   6 }
-            {      0x3f8  10 }
-            {      0x3f9  10 }
-            {      0xffa  12 }
-            {     0x1ff9  13 }
-            {       0x15   6 }
-            {       0xf8   8 }
-            {      0x7fa  11 }
-            {      0x3fa  10 }
-            {      0x3fb  10 }
-            {       0xf9   8 }
-            {      0x7fb  11 }
-            {       0xfa   8 }
-            {       0x16   6 }
-            {       0x17   6 }
-            {       0x18   6 }
-            {        0x0   5 }
-            {        0x1   5 }
-            {        0x2   5 }
-            {       0x19   6 }
-            {       0x1a   6 }
-            {       0x1b   6 }
-            {       0x1c   6 }
-            {       0x1d   6 }
-            {       0x1e   6 }
-            {       0x1f   6 }
-            {       0x5c   7 }
-            {       0xfb   8 }
-            {     0x7ffc  15 }
-            {       0x20   6 }
-            {      0xffb  12 }
-            {      0x3fc  10 }
-            {     0x1ffa  13 }
-            {       0x21   6 }
-            {       0x5d   7 }
-            {       0x5e   7 }
-            {       0x5f   7 }
-            {       0x60   7 }
-            {       0x61   7 }
-            {       0x62   7 }
-            {       0x63   7 }
-            {       0x64   7 }
-            {       0x65   7 }
-            {       0x66   7 }
-            {       0x67   7 }
-            {       0x68   7 }
-            {       0x69   7 }
-            {       0x6a   7 }
-            {       0x6b   7 }
-            {       0x6c   7 }
-            {       0x6d   7 }
-            {       0x6e   7 }
-            {       0x6f   7 }
-            {       0x70   7 }
-            {       0x71   7 }
-            {       0x72   7 }
-            {       0xfc   8 }
-            {       0x73   7 }
-            {       0xfd   8 }
-            {     0x1ffb  13 }
-            {    0x7fff0  19 }
-            {     0x1ffc  13 }
-            {     0x3ffc  14 }
-            {       0x22   6 }
-            {     0x7ffd  15 }
-            {        0x3   5 }
-            {       0x23   6 }
-            {        0x4   5 }
-            {       0x24   6 }
-            {        0x5   5 }
-            {       0x25   6 }
-            {       0x26   6 }
-            {       0x27   6 }
-            {        0x6   5 }
-            {       0x74   7 }
-            {       0x75   7 }
-            {       0x28   6 }
-            {       0x29   6 }
-            {       0x2a   6 }
-            {        0x7   5 }
-            {       0x2b   6 }
-            {       0x76   7 }
-            {       0x2c   6 }
-            {        0x8   5 }
-            {        0x9   5 }
-            {       0x2d   6 }
-            {       0x77   7 }
-            {       0x78   7 }
-            {       0x79   7 }
-            {       0x7a   7 }
-            {       0x7b   7 }
-            {     0x7ffe  15 }
-            {      0x7fc  11 }
-            {     0x3ffd  14 }
-            {     0x1ffd  13 }
-            {  0xffffffc  28 }
-            {    0xfffe6  20 }
-            {   0x3fffd2  22 }
-            {    0xfffe7  20 }
-            {    0xfffe8  20 }
-            {   0x3fffd3  22 }
-            {   0x3fffd4  22 }
-            {   0x3fffd5  22 }
-            {   0x7fffd9  23 }
-            {   0x3fffd6  22 }
-            {   0x7fffda  23 }
-            {   0x7fffdb  23 }
-            {   0x7fffdc  23 }
-            {   0x7fffdd  23 }
-            {   0x7fffde  23 }
-            {   0xffffeb  24 }
-            {   0x7fffdf  23 }
-            {   0xffffec  24 }
-            {   0xffffed  24 }
-            {   0x3fffd7  22 }
-            {   0x7fffe0  23 }
-            {   0xffffee  24 }
-            {   0x7fffe1  23 }
-            {   0x7fffe2  23 }
-            {   0x7fffe3  23 }
-            {   0x7fffe4  23 }
-            {   0x1fffdc  21 }
-            {   0x3fffd8  22 }
-            {   0x7fffe5  23 }
-            {   0x3fffd9  22 }
-            {   0x7fffe6  23 }
-            {   0x7fffe7  23 }
-            {   0xffffef  24 }
-            {   0x3fffda  22 }
-            {   0x1fffdd  21 }
-            {    0xfffe9  20 }
-            {   0x3fffdb  22 }
-            {   0x3fffdc  22 }
-            {   0x7fffe8  23 }
-            {   0x7fffe9  23 }
-            {   0x1fffde  21 }
-            {   0x7fffea  23 }
-            {   0x3fffdd  22 }
-            {   0x3fffde  22 }
-            {   0xfffff0  24 }
-            {   0x1fffdf  21 }
-            {   0x3fffdf  22 }
-            {   0x7fffeb  23 }
-            {   0x7fffec  23 }
-            {   0x1fffe0  21 }
-            {   0x1fffe1  21 }
-            {   0x3fffe0  22 }
-            {   0x1fffe2  21 }
-            {   0x7fffed  23 }
-            {   0x3fffe1  22 }
-            {   0x7fffee  23 }
-            {   0x7fffef  23 }
-            {    0xfffea  20 }
-            {   0x3fffe2  22 }
-            {   0x3fffe3  22 }
-            {   0x3fffe4  22 }
-            {   0x7ffff0  23 }
-            {   0x3fffe5  22 }
-            {   0x3fffe6  22 }
-            {   0x7ffff1  23 }
-            {  0x3ffffe0  26 }
-            {  0x3ffffe1  26 }
-            {    0xfffeb  20 }
-            {    0x7fff1  19 }
-            {   0x3fffe7  22 }
-            {   0x7ffff2  23 }
-            {   0x3fffe8  22 }
-            {  0x1ffffec  25 }
-            {  0x3ffffe2  26 }
-            {  0x3ffffe3  26 }
-            {  0x3ffffe4  26 }
-            {  0x7ffffde  27 }
-            {  0x7ffffdf  27 }
-            {  0x3ffffe5  26 }
-            {   0xfffff1  24 }
-            {  0x1ffffed  25 }
-            {    0x7fff2  19 }
-            {   0x1fffe3  21 }
-            {  0x3ffffe6  26 }
-            {  0x7ffffe0  27 }
-            {  0x7ffffe1  27 }
-            {  0x3ffffe7  26 }
-            {  0x7ffffe2  27 }
-            {   0xfffff2  24 }
-            {   0x1fffe4  21 }
-            {   0x1fffe5  21 }
-            {  0x3ffffe8  26 }
-            {  0x3ffffe9  26 }
-            {  0xffffffd  28 }
-            {  0x7ffffe3  27 }
-            {  0x7ffffe4  27 }
-            {  0x7ffffe5  27 }
-            {    0xfffec  20 }
-            {   0xfffff3  24 }
-            {    0xfffed  20 }
-            {   0x1fffe6  21 }
-            {   0x3fffe9  22 }
-            {   0x1fffe7  21 }
-            {   0x1fffe8  21 }
-            {   0x7ffff3  23 }
-            {   0x3fffea  22 }
-            {   0x3fffeb  22 }
-            {  0x1ffffee  25 }
-            {  0x1ffffef  25 }
-            {   0xfffff4  24 }
-            {   0xfffff5  24 }
-            {  0x3ffffea  26 }
-            {   0x7ffff4  23 }
-            {  0x3ffffeb  26 }
-            {  0x7ffffe6  27 }
-            {  0x3ffffec  26 }
-            {  0x3ffffed  26 }
-            {  0x7ffffe7  27 }
-            {  0x7ffffe8  27 }
-            {  0x7ffffe9  27 }
-            {  0x7ffffea  27 }
-            {  0x7ffffeb  27 }
-            {  0xffffffe  28 }
-            {  0x7ffffec  27 }
-            {  0x7ffffed  27 }
-            {  0x7ffffee  27 }
-            {  0x7ffffef  27 }
-            {  0x7fffff0  27 }
-            {  0x3ffffee  26 }
-            { 0x3fffffff  30 }
-        }
-
-:: R2, ( n -- ) n ,     n 2 64 * + ,     n 1 64 * + ,     n 3 64 * + , ;
-:: R4, ( n -- ) n R2,   n 2 16 * + R2,   n 1 16 * + R2,   n 3 16 * + R2, ;
-:: R6, ( n -- ) n R4,   n 2 4 * + R4,    n 1 4 * + R4,    n 3 4 * + R4, ;
->>
-
-! The codes for each entry in the huffman table
-CONSTANT: huffman-encode-table $[
-    huffman-table [
-        [ integer>bit-array ] dip f pad-tail reverse
-    ] { } assoc>map
-]
-
-CONSTANT: EOS 256
-
-CONSTANT: bit-reverse-table $[
-    [ 0 R6, 2 R6, 1 R6, 3 R6, ] B{ } make
-]
-
-: reverse-bits ( byte-array -- byte-array' )
-    [ bit-reverse-table nth ] B{ } map-as ;
-
-: byte-array>bit-array ( byte-array -- bit-array )
-    [ length 8 * ] [ bit-array boa ] bi ;
-
-! converts a byte array/vector/sequence to a bit array, with
-! each byte in descending order, such that the most significant
-! bit of the first byte is the first bit in the sequence.
-: bytes-to-bits ( bytes -- bits )
-    reverse-bits byte-array>bit-array ;
-
-! most significant bit first.
-: bits-to-bytes ( bits -- bytes )
-    underlying>> reverse-bits ;
-
-ERROR: hpack-huffman-error message ;
-
-! probably inefficient, but it works.
-! just loops over the bits, adding each bit to the current code and searching for
-! the current code, adding the corresponding symbol if the code
-! is found in the table.
-:: huffman-decode ( bytes -- string )
-    BV{ } clone :> byte-vector
-    0 0 ! current code and length
-    bytes bytes-to-bits [
-        [ 2 * ] 2dip 1 0 ? swap 1 [ + ] 2bi@ 
-        2dup 2array huffman-table index
-        [
-            dup EOS = [ "End of Stream in huffman encoded string" hpack-huffman-error ] when
-            byte-vector push 2drop 0 0
-        ] when*
-    ] each
-
-    7 > [ "Padding is too long in huffman encoded string" hpack-huffman-error ] when
-
-    EOS huffman-table nth first integer>bit-array
-    swap integer>bit-array tail?
-    [ "Padding is not the most significant bits of the End of Stream code in huffman encoded string" hpack-huffman-error ] unless
-
-    byte-vector utf8 decode ;
-
-: huffman-encode ( string -- bytes )
-    [ huffman-encode-table nth ] { } map-as concat
-    EOS huffman-encode-table nth over length neg 8 rem head
-    append bits-to-bytes ;
-
diff --git a/basis/http2/server/server.factor b/basis/http2/server/server.factor
deleted file mode 100644 (file)
index f066e96..0000000
+++ /dev/null
@@ -1,68 +0,0 @@
-USING: accessors continuations http http.server http.server.requests
-io io.encodings.ascii io.servers io.sockets io.streams.peek
-io.streams.limited kernel namespaces openssl.libssl ; 
-
-IN: http2.server
-
-! individual connection stuff
-TUPLE: http2-stream ; ! do I even need this?
-
-TUPLE: http2-connection streams settings hpack-decode-context
-hpack-encode-context ;
-
-CONSTANT: client-connection-prefix "PRI * HTTP/2.0\r\n\r\nSM\r\n\r\n"
-
-: start-http2-connection ( threaded-server prev-req/f -- )
-    2drop
-    ! TODO: establish http2 connection and carry out requests
-    ! send settings frame.
-    ! listen for connection prefix and settings from client.
-    ! save settings and send ack.  
-    ;
-
-! the server stuff
-TUPLE: http2-server < http-server ;
-
-! stack effect: ( threaded-server -- )
-M: http2-server handle-client*
-    ! check if this is a secure connection or not
-    ?refresh-all
-    request-limit get limited-input
-    secure-addr dup port>> local-address get port>> = and
-    [ t ! get tls(1.2?) negotiated thing: replace with get_alpn_selected
-      [ f start-http2-connection ] ! if h2, send prefix and start full http2
-      [ call-next-method ] ! else, revert to http1?
-      if ] ! secure case
-    [ ! first, check if the thing sent is connection prefix, and
-      ! if so, start connection
-      ! this line should check for the connection prefix, but
-      ! seems to mess up the stream for when the the request is
-      ! read in read-request.
-      f ! 24 input-stream get <peek-stream> stream-peek client-connection-prefix =
-      [ f start-http2-connection ]
-      [ 
-        [
-          [ read-request ] ?benchmark 
-          dup "Upgrade" header 
-          "h2c" =
-          [ start-http2-connection ] ! if so, send 101 switching protocols response, start http2,
-          ! including sending prefix and response to initial request.
-          [ 
-            ! else, finish processing as http1.
-            nip
-            [ do-request ] ?benchmark 
-            [ do-response ] ?benchmark 
-          ] if 
-        ]
-        [ nip handle-client-error ] recover 
-        ]
-      if ] ! insecure case
-    if
-    ;
-
-: <http2-server> ( -- server )
-    ascii http2-server new-threaded-server
-        "http2.server" >>name
-        "http" protocol-port >>insecure
-        "https" protocol-port >>secure ;
-
diff --git a/extra/http2/hpack/hpack-docs.factor b/extra/http2/hpack/hpack-docs.factor
new file mode 100644 (file)
index 0000000..f381726
--- /dev/null
@@ -0,0 +1,36 @@
+! Copyright (C) 2021 Your name.
+! See http://factorcode.org/license.txt for BSD license.
+USING: byte-arrays help.markup help.syntax kernel sequences strings ;
+IN: http2.hpack
+
+HELP: hpack-context
+{ $class-description "Stores the context for a hpack decoder or encoder. This is primarily the current state of the dynamic table." } ;
+
+HELP: hpack-decode
+{ $values
+    { "decode-context" hpack-context } { "block" byte-array }
+    { "updated-context" hpack-context } { "decoded" sequence }
+}
+{ $description "Decodes the given byte array (or byte vector) in the given hpack context. Outputs the updated context, and the decoded header block as a sequence of pairs." } ;
+
+HELP: hpack-decode-error
+{ $values
+    { "error-msg" string }
+}
+{ $description "Throws a " { $link hpack-decode-error } " error." }
+{ $error-description "Thrown for any of the possible errors specified in RFC7541 for decoding hpack encoded byte strings." } ;
+
+HELP: hpack-encode
+{ $values
+    { "encode-context" hpack-context } { "headers" sequence }
+    { "updated-context" hpack-context } { "block" byte-array }
+}
+{ $description "Encodes the sequence of headers using the given context. Outputs the updated context and the encoded header block, as a byte array." } ;
+
+ARTICLE: "http2.hpack" "HTTP/2 HPACK"
+{ $vocab-link "http2.hpack" }
+;
+
+{ hpack-encode hpack-decode } related-words
+
+ABOUT: "http2.hpack"
diff --git a/extra/http2/hpack/hpack-tests.factor b/extra/http2/hpack/hpack-tests.factor
new file mode 100644 (file)
index 0000000..c6e4a5c
--- /dev/null
@@ -0,0 +1,304 @@
+! Copyright (C) 2021 Your name.
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test http2.hpack http2.hpack.private accessors
+kernel sequences ;
+IN: http2.hpack.tests
+
+! constants are from RFC 7541, appendix C, various sections
+CONSTANT: c1  B{ 234 31 154 10 42 }
+CONSTANT: c21 B{ 0x40 0x0a 0x63 0x75 0x73 0x74 0x6f 0x6d 0x2d
+    0x6b 0x65 0x79 0x0d 0x63 0x75 0x73 0x74 0x6f 0x6d 0x2d
+    0x68 0x65 0x61 0x64 0x65 0x72 }
+CONSTANT: c22 B{ 0x04 0x0c 0x2f 0x73 0x61 0x6d 0x70 0x6c 0x65
+    0x2f 0x70 0x61 0x74 0x68 }
+CONSTANT: c23 B{ 0x10 0x08 0x70 0x61 0x73 0x73 0x77 0x6f 0x72
+    0x64 0x06 0x73 0x65 0x63 0x72 0x65 0x74 }
+CONSTANT: c24 B{ 0x82 }
+
+CONSTANT: c31 B{ 0x82 0x86 0x84 0x41 0x0f 0x77 0x77 0x77 0x2e
+    0x65 0x78 0x61 0x6d 0x70 0x6c 0x65 0x2e 0x63 0x6f 0x6d }
+CONSTANT: c32 B{ 0x82 0x86 0x84 0xbe 0x58 0x08 0x6e 0x6f 0x2d
+    0x63 0x61 0x63 0x68 0x65 }
+CONSTANT: c33 B{ 0x82 0x87 0x85 0xbf 0x40 0x0a 0x63 0x75 0x73
+    0x74 0x6f 0x6d 0x2d 0x6b 0x65 0x79 0x0c 0x63 0x75 0x73
+    0x74 0x6f 0x6d 0x2d 0x76 0x61 0x6c 0x75 0x65 }
+
+CONSTANT: c41 B{ 0x82 0x86 0x84 0x41 0x8c 0xf1 0xe3 0xc2 0xe5
+    0xf2 0x3a 0x6b 0xa0 0xab 0x90 0xf4 0xff }
+CONSTANT: c42 B{ 0x82 0x86 0x84 0xbe 0x58 0x86 0xa8 0xeb 0x10
+    0x64 0x9c 0xbf }
+CONSTANT: c43 B{ 0x82 0x87 0x85 0xbf 0x40 0x88 0x25 0xa8 0x49
+    0xe9 0x5b 0xa9 0x7d 0x7f 0x89 0x25 0xa8 0x49 0xe9 0x5b
+    0xb8 0xe8 0xb4 0xbf }
+
+! These headers are the same as those for section 4
+CONSTANT: c31h { { ":method" "GET" } { ":scheme" "http" }
+    { ":path" "/" } { ":authority" "www.example.com" } }
+CONSTANT: c32h { { ":method" "GET" } { ":scheme" "http" }
+    { ":path" "/" } { ":authority" "www.example.com" } 
+    { "cache-control" "no-cache" } }
+CONSTANT: c33h { { ":method" "GET" } { ":scheme" "https" }
+    { ":path" "/index.html" } { ":authority" "www.example.com" } 
+    { "custom-key" "custom-value" } }
+
+CONSTANT: c51 B{ 0x48 0x03 0x33 0x30 0x32 0x58 0x07 0x70 0x72
+0x69 0x76 0x61 0x74 0x65 0x61 0x1d 0x4d 0x6f 0x6e 0x2c 0x20 0x32
+0x31 0x20 0x4f 0x63 0x74 0x20 0x32 0x30 0x31 0x33 0x20 0x32
+0x30 0x3a 0x31 0x33 0x3a 0x32 0x31 0x20 0x47 0x4d 0x54 0x6e
+0x17 0x68 0x74 0x74 0x70 0x73 0x3a 0x2f 0x2f 0x77 0x77 0x77
+0x2e 0x65 0x78 0x61 0x6d 0x70 0x6c 0x65 0x2e 0x63 0x6f 0x6d }
+CONSTANT: c52 B{ 0x48 0x03 0x33 0x30 0x37 0xc1 0xc0 0xbf }
+CONSTANT: c53 B{ 0x88 0xc1 0x61 0x1d 0x4d 0x6f 0x6e 0x2c 0x20
+0x32 0x31 0x20 0x4f 0x63 0x74 0x20 0x32 0x30 0x31 0x33 0x20 0x32
+0x30 0x3a 0x31 0x33 0x3a 0x32 0x32 0x20 0x47 0x4d 0x54 0xc0
+0x5a 0x04 0x67 0x7a 0x69 0x70 0x77 0x38 0x66 0x6f 0x6f 0x3d
+0x41 0x53 0x44 0x4a 0x4b 0x48 0x51 0x4b 0x42 0x5a 0x58 0x4f
+0x51 0x57 0x45 0x4f 0x50 0x49 0x55 0x41 0x58 0x51 0x57 0x45
+0x4f 0x49 0x55 0x3b 0x20 0x6d 0x61 0x78 0x2d 0x61 0x67 0x65
+0x3d 0x33 0x36 0x30 0x30 0x3b 0x20 0x76 0x65 0x72 0x73 0x69
+0x6f 0x6e 0x3d 0x31 }
+
+CONSTANT: c61 B{ 0x48 0x82 0x64 0x02 0x58 0x85 0xae 0xc3 0x77
+    0x1a 0x4b 0x61 0x96 0xd0 0x7a 0xbe 0x94 0x10 0x54 0xd4
+    0x44 0xa8 0x20 0x05 0x95 0x04 0x0b 0x81 0x66 0xe0 0x82 0xa6
+    0x2d 0x1b 0xff 0x6e 0x91 0x9d 0x29 0xad 0x17 0x18 0x63 0xc7
+    0x8f 0x0b 0x97 0xc8 0xe9 0xae 0x82 0xae 0x43 0xd3 }
+CONSTANT: c62 B{ 0x48 0x83 0x64 0x0e 0xff 0xc1 0xc0 0xbf }
+CONSTANT: c63 B{ 0x88 0xc1 0x61 0x96 0xd0 0x7a 0xbe 0x94 0x10
+    0x54 0xd4 0x44 0xa8 0x20 0x05 0x95 0x04 0x0b 0x81 0x66
+    0xe0 0x84 0xa6 0x2d 0x1b 0xff 0xc0 0x5a 0x83 0x9b 0xd9 0xab
+    0x77 0xad 0x94 0xe7 0x82 0x1d 0xd7 0xf2 0xe6 0xc7 0xb3 0x35
+    0xdf 0xdf 0xcd 0x5b 0x39 0x60 0xd5 0xaf 0x27 0x08 0x7f 0x36
+    0x72 0xc1 0xab 0x27 0x0f 0xb5 0x29 0x1f 0x95 0x87 0x31 0x60
+    0x65 0xc0 0x03 0xed 0x4e 0xe5 0xb1 0x06 0x3d 0x50 0x07 }
+
+! These headers are the same as those for section 6
+CONSTANT: c51h { { ":status" "302" }
+    { "cache-control" "private" }
+    { "date" "Mon, 21 Oct 2013 20:13:21 GMT" }
+    { "location" "https://www.example.com" } }
+CONSTANT: c52h { { ":status" "307" }
+    { "cache-control" "private" }
+    { "date" "Mon, 21 Oct 2013 20:13:21 GMT" }
+    { "location" "https://www.example.com" } }
+CONSTANT: c53h { { ":status" "200" }
+    { "cache-control" "private" }
+    { "date" "Mon, 21 Oct 2013 20:13:22 GMT" }
+    { "location" "https://www.example.com" }
+    { "content-encoding" "gzip" }
+    { "set-cookie" "foo=ASDJKHQKBZXOQWEOPIUAXQWEOIU; max-age=3600; version=1" } }
+
+
+! tests come from RFC 7541, Appendix C
+
+! RFC7541 Appendex C.1
+{ 1   10 } [ c1 0 5 decode-integer nipd ] unit-test
+{ 4 1337 } [ c1 1 5 decode-integer nipd ] unit-test
+{ 5   42 } [ c1 4 8 decode-integer nipd ] unit-test
+
+
+! RFC7541 Appendix C.2.1 subset
+{ 12 "custom-key" }
+[ c21 1 decode-string nipd ] unit-test
+
+! RFC7541 Appendix C.4.3 subset
+{ 24 "custom-value" }
+[ c43 14 decode-string nipd ] unit-test
+
+! RFC7541 Appendix C.2.1
+{ T{ hpack-context f 4096 { { "custom-key" "custom-header" } } } 
+   26 { "custom-key" "custom-header" } }
+[ hpack-context new c21 0 decode-field nipd ] unit-test
+
+! RFC7541 Appendix C.2.2
+{ T{ hpack-context f 4096 { } }  14 { ":path" "/sample/path" } }
+[ hpack-context new c22 0 decode-field nipd ] unit-test
+
+! RFC7541 Appendix C.2.3
+{ T{ hpack-context f 4096 { } } 17 { "password" "secret" } }
+[ hpack-context new c23 0 decode-field nipd ] unit-test
+
+! RFC7541 Appendix C.2.4
+{ T{ hpack-context f 4096 { } } 1 { ":method" "GET" } }
+[ hpack-context new c24 0 decode-field nipd ] unit-test
+
+
+! RFC7541 Appendix C.3
+{
+    { { ":method" "GET" } { ":scheme" "http" }
+        { ":path" "/" } { ":authority" "www.example.com" } }
+    { { ":method" "GET" } { ":scheme" "http" }
+        { ":path" "/" } { ":authority" "www.example.com" } 
+        { "cache-control" "no-cache" } }
+    { { ":method" "GET" } { ":scheme" "https" }
+        { ":path" "/index.html" } { ":authority" "www.example.com" } 
+        { "custom-key" "custom-value" } }
+    T{ hpack-context f 4096 { { "custom-key" "custom-value" }
+                                { "cache-control" "no-cache" }
+                                { ":authority" "www.example.com" } } }
+}
+[ hpack-context new c31 c32 c33 [ hpack-decode swap ] tri@ ] unit-test
+
+! RFC7541 Appendix C.4
+{
+    { { ":method" "GET" } { ":scheme" "http" }
+        { ":path" "/" } { ":authority" "www.example.com" } }
+    { { ":method" "GET" } { ":scheme" "http" }
+        { ":path" "/" } { ":authority" "www.example.com" } 
+        { "cache-control" "no-cache" } }
+    { { ":method" "GET" } { ":scheme" "https" }
+        { ":path" "/index.html" } { ":authority" "www.example.com" } 
+        { "custom-key" "custom-value" } }
+    T{ hpack-context f 4096 { { "custom-key" "custom-value" }
+                                { "cache-control" "no-cache" }
+                                { ":authority" "www.example.com" } } }
+}
+[ hpack-context new c41 c42 c43 [ hpack-decode swap ] tri@ ] unit-test
+
+! RFC7541 Appendix C.5
+{
+    {
+        { ":status" "302" }
+        { "cache-control" "private" }
+        { "date" "Mon, 21 Oct 2013 20:13:21 GMT" }
+        { "location" "https://www.example.com" }
+    }
+    {
+        { ":status" "307" }
+        { "cache-control" "private" }
+        { "date" "Mon, 21 Oct 2013 20:13:21 GMT" }
+        { "location" "https://www.example.com" }
+    }
+    {
+        { ":status" "200" }
+        { "cache-control" "private" }
+        { "date" "Mon, 21 Oct 2013 20:13:22 GMT" }
+        { "location" "https://www.example.com" }
+        { "content-encoding" "gzip" }
+        { "set-cookie" "foo=ASDJKHQKBZXOQWEOPIUAXQWEOIU; max-age=3600; version=1" }
+    }
+    T{ hpack-context f 256 { { "set-cookie" "foo=ASDJKHQKBZXOQWEOPIUAXQWEOIU; max-age=3600; version=1" }
+                             { "content-encoding" "gzip" }
+                             { "date" "Mon, 21 Oct 2013 20:13:22 GMT" } } }
+}
+[ hpack-context new 256 >>max-size c51 c52 c53
+    [ hpack-decode swap ] tri@ ] unit-test
+
+! RFC7541 Appendix C.6
+{
+    {
+        { ":status" "302" }
+        { "cache-control" "private" }
+        { "date" "Mon, 21 Oct 2013 20:13:21 GMT" }
+        { "location" "https://www.example.com" }
+    }
+    {
+        { ":status" "307" }
+        { "cache-control" "private" }
+        { "date" "Mon, 21 Oct 2013 20:13:21 GMT" }
+        { "location" "https://www.example.com" }
+    }
+    {
+        { ":status" "200" }
+        { "cache-control" "private" }
+        { "date" "Mon, 21 Oct 2013 20:13:22 GMT" }
+        { "location" "https://www.example.com" }
+        { "content-encoding" "gzip" }
+        { "set-cookie" "foo=ASDJKHQKBZXOQWEOPIUAXQWEOIU; max-age=3600; version=1" }
+    }
+    T{ hpack-context f 256 { { "set-cookie" "foo=ASDJKHQKBZXOQWEOPIUAXQWEOIU; max-age=3600; version=1" }
+                             { "content-encoding" "gzip" }
+                             { "date" "Mon, 21 Oct 2013 20:13:22 GMT" } } }
+}
+[ hpack-context new 256 >>max-size c61 c62 c63
+    [ hpack-decode swap ] tri@ ] unit-test
+
+
+! encoding can be tested primarily by ensuring the encoding and
+! decoding of an object yields the same object (since encoding
+! does not have a well defined output other then `decodable').
+
+
+! integer and string encoding tests
+{ B{ 0b00101010 } } [ 0b00100000 10 5 encode-integer ] unit-test
+{ B{ 0b01011111 0b10011010 0b00001010 } } [ 0b01000000 1337 5 encode-integer ] unit-test
+{ B{ 0b00101010 } } [ 0b00000000 42 8 encode-integer ] unit-test
+
+{ B{ 0x0a 0x63 0x75 0x73 0x74 0x6f 0x6d 0x2d 0x6b 0x65 0x79 } }
+[ "custom-key" encode-string-raw ] unit-test
+
+{ B{ 0x88 0x25 0xa8 0x49 0xe9 0x5b 0xa9 0x7d 0x7f } }
+[ "custom-key" encode-string-huffman ] unit-test
+
+
+! single header encoding check, mirrors the tests from RFC 7541, Appendix C.2
+{ t t { "custom-key" "custom-header" } }
+[ hpack-context new { "custom-key" "custom-header" } encode-field 
+  hpack-context new swap 0 decode-field 
+  [ [ = ] [ swap length = ] 2bi* ] dip ! check contexts are the same and the entire block used for decoding 
+] unit-test
+
+{ t t { ":path" "/sample/path" } }
+[ hpack-context new { ":path" "/sample/path" } encode-field 
+  hpack-context new swap 0 decode-field 
+  [ [ = ] [ swap length = ] 2bi* ] dip ! check contexts are the same and the entire block used for decoding 
+] unit-test
+
+{ t t { "password" "secret" } }
+[ hpack-context new { "password" "secret" } encode-field 
+  hpack-context new swap 0 decode-field 
+  [ [ = ] [ swap length = ] 2bi* ] dip ! check contexts are the same and the entire block used for decoding 
+] unit-test
+
+{ t t { ":method" "GET" } }
+[ hpack-context new { ":method" "GET" } encode-field 
+  hpack-context new swap 0 decode-field 
+  [ [ = ] [ swap length = ] 2bi* ] dip ! check contexts are the same and the entire block used for decoding 
+] unit-test
+
+
+! many header encoding check, using same values from RFC7541 Appendix C.3 and C.5
+{
+    { { ":method" "GET" } { ":scheme" "http" }
+        { ":path" "/" } { ":authority" "www.example.com" } }
+    { { ":method" "GET" } { ":scheme" "http" }
+        { ":path" "/" } { ":authority" "www.example.com" } 
+        { "cache-control" "no-cache" } }
+    { { ":method" "GET" } { ":scheme" "https" }
+        { ":path" "/index.html" } { ":authority" "www.example.com" } 
+        { "custom-key" "custom-value" } }
+    t
+}
+[ hpack-context new c31h c32h c33h [ hpack-encode swap ] tri@ 
+  [ [ hpack-context new ] 3dip [ hpack-decode swap ] tri@ ] dip
+  = ! check that the encode and decode contexts are identical
+] unit-test
+
+{
+    {
+        { ":status" "302" }
+        { "cache-control" "private" }
+        { "date" "Mon, 21 Oct 2013 20:13:21 GMT" }
+        { "location" "https://www.example.com" }
+    }
+    {
+        { ":status" "307" }
+        { "cache-control" "private" }
+        { "date" "Mon, 21 Oct 2013 20:13:21 GMT" }
+        { "location" "https://www.example.com" }
+    }
+    {
+        { ":status" "200" }
+        { "cache-control" "private" }
+        { "date" "Mon, 21 Oct 2013 20:13:22 GMT" }
+        { "location" "https://www.example.com" }
+        { "content-encoding" "gzip" }
+        { "set-cookie" "foo=ASDJKHQKBZXOQWEOPIUAXQWEOIU; max-age=3600; version=1" }
+    }
+    t
+}
+[ hpack-context new c51h c52h c53h [ hpack-encode swap ] tri@ 
+  [ [ hpack-context new ] 3dip [ hpack-decode swap ] tri@ ] dip
+  = ! check that the encode and decode contexts are identical
+] unit-test
+
diff --git a/extra/http2/hpack/hpack.factor b/extra/http2/hpack/hpack.factor
new file mode 100644 (file)
index 0000000..5fbfad5
--- /dev/null
@@ -0,0 +1,281 @@
+USING: accessors arrays byte-arrays byte-vectors combinators fry
+http2.hpack.huffman io.encodings.string io.encodings.utf8 locals
+kernel math math.functions math.bitwise multiline sequences ;
+
+IN: http2.hpack
+
+TUPLE: hpack-context
+    { max-size integer initial: 4096 } { dynamic-table initial: { } } ;
+    ! default the max size to 4096 according to RFC7540
+
+ERROR: hpack-decode-error error-msg ;
+
+<PRIVATE
+
+! The static table for hpack compression/decompression,
+! from RFC 7541, Appendix A.
+CONSTANT: static-table {
+    { f f } ! allows indexing to work out properly
+    { ":authority" f }
+    { ":method" "GET" }
+    { ":method" "POST" }
+    { ":path" "/" }
+    { ":path" "/index.html" }
+    { ":scheme" "http" }
+    { ":scheme" "https" }
+    { ":status" "200" }
+    { ":status" "204" }
+    { ":status" "206" }
+    { ":status" "304" }
+    { ":status" "400" }
+    { ":status" "404" }
+    { ":status" "500" }
+    { "accept-charset" f }
+    { "accept-encoding" "gzip, deflate" }
+    { "accept-language" f }
+    { "accept-ranges" f }
+    { "accept" f }
+    { "access-control-allow-origin" f }
+    { "age" f }
+    { "allow" f }
+    { "authorization" f }
+    { "cache-control" f }
+    { "content-disposition" f }
+    { "content-encoding" f }
+    { "content-language" f }
+    { "content-length" f }
+    { "content-location" f }
+    { "content-range" f }
+    { "content-type" f }
+    { "cookie" f }
+    { "date" f }
+    { "etag" f }
+    { "expect" f }
+    { "expires" f }
+    { "from" f }
+    { "host" f }
+    { "if-match" f }
+    { "if-modified-since" f }
+    { "if-none-match" f }
+    { "if-range" f }
+    { "if-unmodified-since" f }
+    { "last-modified" f }
+    { "link" f }
+    { "location" f }
+    { "max-forwards" f }
+    { "proxy-authenticate" f }
+    { "proxy-authorization" f }
+    { "range" f }
+    { "referer" f }
+    { "refresh" f }
+    { "retry-after" f }
+    { "server" f }
+    { "set-cookie" f }
+    { "strict-transport-security" f }
+    { "transfer-encoding" f }
+    { "user-agent" f }
+    { "vary" f }
+    { "via" f }
+    { "www-authenticate" f }
+}
+
+: header-size ( header -- size )
+    sum-lengths 32 +
+    ;
+
+! gives the index in the dynamic table such that the sum of the
+! size of the elements before the index is less than or equal to
+! the desired-size, or f if no entries need to be removed to
+! attain the desired size
+:: dynamic-table-remove-index ( dynamic-table desired-size -- i/f )
+    0 dynamic-table [ header-size + dup desired-size >= ] find drop nip
+    ;
+
+! shrinks the dynamic table size to the given size (size, *not*
+! length) (doesn't affect the max-size of the context)
+: shrink-dynamic-table ( dynamic-table shrink-to -- shrunk-dynamic-table )
+    dupd dynamic-table-remove-index [ head ] when*
+    ;
+
+:: add-header-to-table ( hpack-context header -- updated-context )
+    hpack-context dynamic-table>> hpack-context max-size>>
+    header header-size - shrink-dynamic-table
+    header header-size hpack-context max-size>> <= [ header prefix ] when
+    hpack-context swap >>dynamic-table
+    ;
+
+: set-dynamic-table-size ( hpack-context new-size -- updated-decode-context )
+    [ >>max-size ] keep
+    [ dup dynamic-table>> ] dip shrink-dynamic-table >>dynamic-table
+    ;
+
+! check bounds: i < len(static-table++decode-context) and i > 0
+: check-index-bounds ( index decode-context -- )
+    [ drop 0 > ] [ dynamic-table>> length static-table length + < ] 2bi
+    and [ "invalid index given" hpack-decode-error ] unless ! if not valid throw error
+    ;
+
+: get-header-from-table ( hpack-context table-index -- field )
+    [ swap check-index-bounds ] 2keep
+    dup static-table length <  ! check if in static table
+    [ static-table nth nip ]
+    [ static-table length - swap dynamic-table>> nth ]
+    if ;
+
+: search-imperfect ( header table -- imperfect/f )
+    swap first '[ _ first = ] find drop
+    ;
+
+: search-given-table ( header table -- imperfect/f perfect/f )
+    [ search-imperfect ] [ index ] 2bi
+    ;
+
+: correct-dynamic-index ( dynamic-index/f -- whole-table-index/f )
+    [ static-table length + ] [ f ] if*
+    ;
+
+: search-static-table ( header -- imperfect/f perfect/f )
+    static-table search-given-table ;
+
+: search-dynamic-table ( header hpack-context --  imperfect/f perfect/f )
+    dynamic-table>> search-given-table
+    [ correct-dynamic-index ] bi@
+    ;
+
+: search-table ( header hpack-context -- imperfect/f perfect/f )
+    [ drop search-static-table ] [ search-dynamic-table ] 2bi
+    ! combine results from static and dynamic tables
+    swapd [ or ] 2bi@
+    ;
+
+
+! assumes the first-byte respects the prefix-length, such that
+! the last prefix-length bits are all 0.
+: encode-integer ( first-byte int prefix-length -- bytes )
+    2^ 1 - 2dup < 
+    [ drop bitor 1byte-array ]
+    [ swap over [ bitor 1byte-array >byte-vector ] [ - ] 2bi* 
+      [ dup 128 >= ] [ [ 128 mod 128 + over push ] [ 128 /i ] bi ]
+      while over push >byte-array
+    ] if ;
+
+! encodes a string without huffman encoding.
+: encode-string-raw ( string -- bytes )
+    utf8 encode
+    0 over length 7 encode-integer
+    prepend
+    ;
+
+: encode-string-huffman ( string -- bytes )
+    huffman-encode
+    128 over length 7 encode-integer
+    prepend
+    ;
+
+:: encode-field ( encode-context header -- updated-context block )
+    header encode-context search-table
+    [ 128 swap 7 encode-integer encode-context swap nipd ]
+    [ [ 64 swap 6 encode-integer ]
+      [ 64 0 6 encode-integer header first encode-string-huffman append
+        ] if* 
+        header second encode-string-huffman append
+        encode-context header add-header-to-table swap ]
+    if*
+    ;   
+
+! /*
+! version of decode integer that tries to be clever for less
+! stack stuff, but not sure if it actually is...
+:: decode-integer ( block current-index prefix-length -- block new-index number )
+    current-index 1 + :> end-index!
+    current-index block nth prefix-length 2^ 1 - [ mask ] keep over =
+    [
+        current-index 1 + block [ 7 bit? not ] find-from drop 1 + end-index!
+        current-index 1 + end-index block subseq reverse
+        0 [ 127 mask swap 128 * + ] reduce
+        +
+    ] when
+    [ block end-index ] dip ; ! */
+
+/*
+! initial version of decode-integer, which closely follows the
+! pseudocode from the rfc (RFC 7541, section 5.1)
+: decode-integer-fragment ( block index I M -- block index+1 I' M+7 block[index+1] )
+    ! increment index and get block[index]
+    [ 1 + 2dup swap nth ] 2dip
+    ! stack: block index+1 block[index+1] I M
+    ! compute I' = (block[index+1] & 127) * 2^M + I
+    pick 127 mask 2 pick ^ * '[ _ + ] dip
+    7 + rot ;
+
+: decode-integer ( block current-index prefix-length -- block new-index number )
+    ! get the current octet, compute mask, apply mask
+    [ 2dup swap nth ] dip 2^ 1 - [ mask ] keep
+    over = 
+    ! stack: block index I loop?
+    [ 0
+      [ 7 bit? ] [ decode-integer-fragment ] do while 
+      ! stack: block index I M, get rid of M, we don't need it
+      drop ]
+    when ! the prefix matches the mask (exactly all 1s), must loop
+    [ 1 + ] dip ! increment the index before return
+    ; ! */
+
+: decode-raw-string ( block current-index string-length -- block new-index string )
+    over + dup [ pick subseq utf8 decode ] dip swap ;
+
+: decode-huffman-string ( block current-index string-length -- block new-index string )
+    over + dup [ pick subseq huffman-decode ] dip swap 
+    ;
+
+: decode-string ( block current-index -- block new-index string )
+    [ 7 decode-integer ] [ swap nth 7 bit? ] 2bi
+    [ decode-huffman-string ] [ decode-raw-string ] if ; 
+
+: decode-literal-header ( decode-context block index index-length -- decode-context block new-index field )
+    decode-integer
+    ! string name if 0, else indexed
+    [ decode-string ] [ pickd get-header-from-table first ] if-zero
+    [ decode-string ] dip swap 2array
+    ;
+
+! block will be a byte array
+:: decode-field ( decode-context block index -- updated-context block new-index field/f )
+    decode-context block index
+    {
+        ! indexed header field
+        { [ index block nth 7 bit? ] [ 7 decode-integer 
+                decode-context swap get-header-from-table ] } 
+        ! Literal header field with incremental indexing
+        { [ index block nth 6 bit? ] [ 6 decode-literal-header 
+                [ 2nip add-header-to-table ] 3keep ] } 
+        ! dynamic table size update
+        { [ index block nth 5 bit? ] [ 5 decode-integer -rot f
+                [ set-dynamic-table-size ] 3dip ] }
+        ! literal header field without indexing
+        [ 4 decode-literal-header ]
+    } cond ;
+
+PRIVATE>
+
+! headers is a sequence of tuples represented the unencoded headers
+: hpack-encode ( encode-context headers -- updated-context block ) 
+    [ encode-field ] map concat ;
+
+
+! should give the updated dtable, and the list of decoded
+! header fields. block is the bytestring (byte array) for the header block
+: hpack-decode ( decode-context block -- updated-context decoded )
+    [let V{ } clone :> decoded-list
+    0 ! index in the block
+    [ 2dup swap length < ] ! check that the block is longer than the index
+    ! call decode-field and add the (possibly) decoded field to the list
+    [ decode-field [ decoded-list push ]
+                   [ decoded-list [ "Table size update not at start of header block"
+                   hpack-decode-error ] unless-empty ] if* ]
+    ! if the table was not empty, and we didn't get a header, throw an error.
+    while
+    2drop decoded-list >array
+    ! double check the header list size?
+    ] ;
+
diff --git a/extra/http2/hpack/huffman/huffman.factor b/extra/http2/hpack/huffman/huffman.factor
new file mode 100644 (file)
index 0000000..3344c92
--- /dev/null
@@ -0,0 +1,333 @@
+USING: accessors arrays assocs bit-arrays http2.hpack
+io.encodings.string io.encodings.utf8 kernel literals locals
+make math sequences ;
+
+IN: http2.hpack.huffman
+
+<<
+! Table contents from RFC 7541 Appendix B
+CONSTANT: huffman-table {
+            {     0x1ff8  13 }
+            {   0x7fffd8  23 }
+            {  0xfffffe2  28 }
+            {  0xfffffe3  28 }
+            {  0xfffffe4  28 }
+            {  0xfffffe5  28 }
+            {  0xfffffe6  28 }
+            {  0xfffffe7  28 }
+            {  0xfffffe8  28 }
+            {   0xffffea  24 }
+            { 0x3ffffffc  30 }
+            {  0xfffffe9  28 }
+            {  0xfffffea  28 }
+            { 0x3ffffffd  30 }
+            {  0xfffffeb  28 }
+            {  0xfffffec  28 }
+            {  0xfffffed  28 }
+            {  0xfffffee  28 }
+            {  0xfffffef  28 }
+            {  0xffffff0  28 }
+            {  0xffffff1  28 }
+            {  0xffffff2  28 }
+            { 0x3ffffffe  30 }
+            {  0xffffff3  28 }
+            {  0xffffff4  28 }
+            {  0xffffff5  28 }
+            {  0xffffff6  28 }
+            {  0xffffff7  28 }
+            {  0xffffff8  28 }
+            {  0xffffff9  28 }
+            {  0xffffffa  28 }
+            {  0xffffffb  28 }
+            {       0x14   6 }
+            {      0x3f8  10 }
+            {      0x3f9  10 }
+            {      0xffa  12 }
+            {     0x1ff9  13 }
+            {       0x15   6 }
+            {       0xf8   8 }
+            {      0x7fa  11 }
+            {      0x3fa  10 }
+            {      0x3fb  10 }
+            {       0xf9   8 }
+            {      0x7fb  11 }
+            {       0xfa   8 }
+            {       0x16   6 }
+            {       0x17   6 }
+            {       0x18   6 }
+            {        0x0   5 }
+            {        0x1   5 }
+            {        0x2   5 }
+            {       0x19   6 }
+            {       0x1a   6 }
+            {       0x1b   6 }
+            {       0x1c   6 }
+            {       0x1d   6 }
+            {       0x1e   6 }
+            {       0x1f   6 }
+            {       0x5c   7 }
+            {       0xfb   8 }
+            {     0x7ffc  15 }
+            {       0x20   6 }
+            {      0xffb  12 }
+            {      0x3fc  10 }
+            {     0x1ffa  13 }
+            {       0x21   6 }
+            {       0x5d   7 }
+            {       0x5e   7 }
+            {       0x5f   7 }
+            {       0x60   7 }
+            {       0x61   7 }
+            {       0x62   7 }
+            {       0x63   7 }
+            {       0x64   7 }
+            {       0x65   7 }
+            {       0x66   7 }
+            {       0x67   7 }
+            {       0x68   7 }
+            {       0x69   7 }
+            {       0x6a   7 }
+            {       0x6b   7 }
+            {       0x6c   7 }
+            {       0x6d   7 }
+            {       0x6e   7 }
+            {       0x6f   7 }
+            {       0x70   7 }
+            {       0x71   7 }
+            {       0x72   7 }
+            {       0xfc   8 }
+            {       0x73   7 }
+            {       0xfd   8 }
+            {     0x1ffb  13 }
+            {    0x7fff0  19 }
+            {     0x1ffc  13 }
+            {     0x3ffc  14 }
+            {       0x22   6 }
+            {     0x7ffd  15 }
+            {        0x3   5 }
+            {       0x23   6 }
+            {        0x4   5 }
+            {       0x24   6 }
+            {        0x5   5 }
+            {       0x25   6 }
+            {       0x26   6 }
+            {       0x27   6 }
+            {        0x6   5 }
+            {       0x74   7 }
+            {       0x75   7 }
+            {       0x28   6 }
+            {       0x29   6 }
+            {       0x2a   6 }
+            {        0x7   5 }
+            {       0x2b   6 }
+            {       0x76   7 }
+            {       0x2c   6 }
+            {        0x8   5 }
+            {        0x9   5 }
+            {       0x2d   6 }
+            {       0x77   7 }
+            {       0x78   7 }
+            {       0x79   7 }
+            {       0x7a   7 }
+            {       0x7b   7 }
+            {     0x7ffe  15 }
+            {      0x7fc  11 }
+            {     0x3ffd  14 }
+            {     0x1ffd  13 }
+            {  0xffffffc  28 }
+            {    0xfffe6  20 }
+            {   0x3fffd2  22 }
+            {    0xfffe7  20 }
+            {    0xfffe8  20 }
+            {   0x3fffd3  22 }
+            {   0x3fffd4  22 }
+            {   0x3fffd5  22 }
+            {   0x7fffd9  23 }
+            {   0x3fffd6  22 }
+            {   0x7fffda  23 }
+            {   0x7fffdb  23 }
+            {   0x7fffdc  23 }
+            {   0x7fffdd  23 }
+            {   0x7fffde  23 }
+            {   0xffffeb  24 }
+            {   0x7fffdf  23 }
+            {   0xffffec  24 }
+            {   0xffffed  24 }
+            {   0x3fffd7  22 }
+            {   0x7fffe0  23 }
+            {   0xffffee  24 }
+            {   0x7fffe1  23 }
+            {   0x7fffe2  23 }
+            {   0x7fffe3  23 }
+            {   0x7fffe4  23 }
+            {   0x1fffdc  21 }
+            {   0x3fffd8  22 }
+            {   0x7fffe5  23 }
+            {   0x3fffd9  22 }
+            {   0x7fffe6  23 }
+            {   0x7fffe7  23 }
+            {   0xffffef  24 }
+            {   0x3fffda  22 }
+            {   0x1fffdd  21 }
+            {    0xfffe9  20 }
+            {   0x3fffdb  22 }
+            {   0x3fffdc  22 }
+            {   0x7fffe8  23 }
+            {   0x7fffe9  23 }
+            {   0x1fffde  21 }
+            {   0x7fffea  23 }
+            {   0x3fffdd  22 }
+            {   0x3fffde  22 }
+            {   0xfffff0  24 }
+            {   0x1fffdf  21 }
+            {   0x3fffdf  22 }
+            {   0x7fffeb  23 }
+            {   0x7fffec  23 }
+            {   0x1fffe0  21 }
+            {   0x1fffe1  21 }
+            {   0x3fffe0  22 }
+            {   0x1fffe2  21 }
+            {   0x7fffed  23 }
+            {   0x3fffe1  22 }
+            {   0x7fffee  23 }
+            {   0x7fffef  23 }
+            {    0xfffea  20 }
+            {   0x3fffe2  22 }
+            {   0x3fffe3  22 }
+            {   0x3fffe4  22 }
+            {   0x7ffff0  23 }
+            {   0x3fffe5  22 }
+            {   0x3fffe6  22 }
+            {   0x7ffff1  23 }
+            {  0x3ffffe0  26 }
+            {  0x3ffffe1  26 }
+            {    0xfffeb  20 }
+            {    0x7fff1  19 }
+            {   0x3fffe7  22 }
+            {   0x7ffff2  23 }
+            {   0x3fffe8  22 }
+            {  0x1ffffec  25 }
+            {  0x3ffffe2  26 }
+            {  0x3ffffe3  26 }
+            {  0x3ffffe4  26 }
+            {  0x7ffffde  27 }
+            {  0x7ffffdf  27 }
+            {  0x3ffffe5  26 }
+            {   0xfffff1  24 }
+            {  0x1ffffed  25 }
+            {    0x7fff2  19 }
+            {   0x1fffe3  21 }
+            {  0x3ffffe6  26 }
+            {  0x7ffffe0  27 }
+            {  0x7ffffe1  27 }
+            {  0x3ffffe7  26 }
+            {  0x7ffffe2  27 }
+            {   0xfffff2  24 }
+            {   0x1fffe4  21 }
+            {   0x1fffe5  21 }
+            {  0x3ffffe8  26 }
+            {  0x3ffffe9  26 }
+            {  0xffffffd  28 }
+            {  0x7ffffe3  27 }
+            {  0x7ffffe4  27 }
+            {  0x7ffffe5  27 }
+            {    0xfffec  20 }
+            {   0xfffff3  24 }
+            {    0xfffed  20 }
+            {   0x1fffe6  21 }
+            {   0x3fffe9  22 }
+            {   0x1fffe7  21 }
+            {   0x1fffe8  21 }
+            {   0x7ffff3  23 }
+            {   0x3fffea  22 }
+            {   0x3fffeb  22 }
+            {  0x1ffffee  25 }
+            {  0x1ffffef  25 }
+            {   0xfffff4  24 }
+            {   0xfffff5  24 }
+            {  0x3ffffea  26 }
+            {   0x7ffff4  23 }
+            {  0x3ffffeb  26 }
+            {  0x7ffffe6  27 }
+            {  0x3ffffec  26 }
+            {  0x3ffffed  26 }
+            {  0x7ffffe7  27 }
+            {  0x7ffffe8  27 }
+            {  0x7ffffe9  27 }
+            {  0x7ffffea  27 }
+            {  0x7ffffeb  27 }
+            {  0xffffffe  28 }
+            {  0x7ffffec  27 }
+            {  0x7ffffed  27 }
+            {  0x7ffffee  27 }
+            {  0x7ffffef  27 }
+            {  0x7fffff0  27 }
+            {  0x3ffffee  26 }
+            { 0x3fffffff  30 }
+        }
+
+:: R2, ( n -- ) n ,     n 2 64 * + ,     n 1 64 * + ,     n 3 64 * + , ;
+:: R4, ( n -- ) n R2,   n 2 16 * + R2,   n 1 16 * + R2,   n 3 16 * + R2, ;
+:: R6, ( n -- ) n R4,   n 2 4 * + R4,    n 1 4 * + R4,    n 3 4 * + R4, ;
+>>
+
+! The codes for each entry in the huffman table
+CONSTANT: huffman-encode-table $[
+    huffman-table [
+        [ integer>bit-array ] dip f pad-tail reverse
+    ] { } assoc>map
+]
+
+CONSTANT: EOS 256
+
+CONSTANT: bit-reverse-table $[
+    [ 0 R6, 2 R6, 1 R6, 3 R6, ] B{ } make
+]
+
+: reverse-bits ( byte-array -- byte-array' )
+    [ bit-reverse-table nth ] B{ } map-as ;
+
+: byte-array>bit-array ( byte-array -- bit-array )
+    [ length 8 * ] [ bit-array boa ] bi ;
+
+! converts a byte array/vector/sequence to a bit array, with
+! each byte in descending order, such that the most significant
+! bit of the first byte is the first bit in the sequence.
+: bytes-to-bits ( bytes -- bits )
+    reverse-bits byte-array>bit-array ;
+
+! most significant bit first.
+: bits-to-bytes ( bits -- bytes )
+    underlying>> reverse-bits ;
+
+ERROR: hpack-huffman-error message ;
+
+! probably inefficient, but it works.
+! just loops over the bits, adding each bit to the current code and searching for
+! the current code, adding the corresponding symbol if the code
+! is found in the table.
+:: huffman-decode ( bytes -- string )
+    BV{ } clone :> byte-vector
+    0 0 ! current code and length
+    bytes bytes-to-bits [
+        [ 2 * ] 2dip 1 0 ? swap 1 [ + ] 2bi@ 
+        2dup 2array huffman-table index
+        [
+            dup EOS = [ "End of Stream in huffman encoded string" hpack-huffman-error ] when
+            byte-vector push 2drop 0 0
+        ] when*
+    ] each
+
+    7 > [ "Padding is too long in huffman encoded string" hpack-huffman-error ] when
+
+    EOS huffman-table nth first integer>bit-array
+    swap integer>bit-array tail?
+    [ "Padding is not the most significant bits of the End of Stream code in huffman encoded string" hpack-huffman-error ] unless
+
+    byte-vector utf8 decode ;
+
+: huffman-encode ( string -- bytes )
+    [ huffman-encode-table nth ] { } map-as concat
+    EOS huffman-encode-table nth over length neg 8 rem head
+    append bits-to-bytes ;
+
diff --git a/extra/http2/server/server.factor b/extra/http2/server/server.factor
new file mode 100644 (file)
index 0000000..f066e96
--- /dev/null
@@ -0,0 +1,68 @@
+USING: accessors continuations http http.server http.server.requests
+io io.encodings.ascii io.servers io.sockets io.streams.peek
+io.streams.limited kernel namespaces openssl.libssl ; 
+
+IN: http2.server
+
+! individual connection stuff
+TUPLE: http2-stream ; ! do I even need this?
+
+TUPLE: http2-connection streams settings hpack-decode-context
+hpack-encode-context ;
+
+CONSTANT: client-connection-prefix "PRI * HTTP/2.0\r\n\r\nSM\r\n\r\n"
+
+: start-http2-connection ( threaded-server prev-req/f -- )
+    2drop
+    ! TODO: establish http2 connection and carry out requests
+    ! send settings frame.
+    ! listen for connection prefix and settings from client.
+    ! save settings and send ack.  
+    ;
+
+! the server stuff
+TUPLE: http2-server < http-server ;
+
+! stack effect: ( threaded-server -- )
+M: http2-server handle-client*
+    ! check if this is a secure connection or not
+    ?refresh-all
+    request-limit get limited-input
+    secure-addr dup port>> local-address get port>> = and
+    [ t ! get tls(1.2?) negotiated thing: replace with get_alpn_selected
+      [ f start-http2-connection ] ! if h2, send prefix and start full http2
+      [ call-next-method ] ! else, revert to http1?
+      if ] ! secure case
+    [ ! first, check if the thing sent is connection prefix, and
+      ! if so, start connection
+      ! this line should check for the connection prefix, but
+      ! seems to mess up the stream for when the the request is
+      ! read in read-request.
+      f ! 24 input-stream get <peek-stream> stream-peek client-connection-prefix =
+      [ f start-http2-connection ]
+      [ 
+        [
+          [ read-request ] ?benchmark 
+          dup "Upgrade" header 
+          "h2c" =
+          [ start-http2-connection ] ! if so, send 101 switching protocols response, start http2,
+          ! including sending prefix and response to initial request.
+          [ 
+            ! else, finish processing as http1.
+            nip
+            [ do-request ] ?benchmark 
+            [ do-response ] ?benchmark 
+          ] if 
+        ]
+        [ nip handle-client-error ] recover 
+        ]
+      if ] ! insecure case
+    if
+    ;
+
+: <http2-server> ( -- server )
+    ascii http2-server new-threaded-server
+        "http2.server" >>name
+        "http" protocol-port >>insecure
+        "https" protocol-port >>secure ;
+