preliminary minimal changes

META6.json

@@ -30,7 +30,8 @@
     "HTTP::Response": "lib/HTTP/Response.rakumod",
     "HTTP::UserAgent": "lib/HTTP/UserAgent.rakumod",
     "HTTP::UserAgent::Common": "lib/HTTP/UserAgent/Common.rakumod",
-    "HTTP::UserAgent::Exception": "lib/HTTP/UserAgent/Exception.rakumod"
+    "HTTP::UserAgent::Exception": "lib/HTTP/UserAgent/Exception.rakumod",
+    "HTTP::Header::ETag": "lib/HTTP/Header/ETag.rakumod"
   },
   "raku": "6.*",
   "resources": [

lib/HTTP/Header.rakumod

@@ -1,10 +1,93 @@
 unit class HTTP::Header;
 
 use HTTP::Header::Field;
+use HTTP::Header::ETag;
 
+my constant $CRLF = "\x[0D]\x[0A]";
+
+has Bool $.strict is rw;
 # headers container
 has @.fields;
 
+grammar Grammar::Strict {
+    token TOP {
+        <message-header>
+    }
+    token message-header {
+        [ <[\t\x[20]]>* <field> <[\t\x[20]]>* \x[0d]\x[0a] ]*
+    }
+    #| includes any VCHAR except delimiters
+    #| https://datatracker.ietf.org/doc/html/rfc9110#name-tokens
+    token token {
+        <[!#$%&'*+\-.^_`|~0..9a..zA..Z]>+
+    }
+    token field {
+        | <etag>
+        | <other-field>
+    }
+    token other-field {
+        $<field-name>=<token> ':' \s* [ <value> | <quoted-string> ]
+    }
+    token etag {
+        $<field-name>=[<[eE]><[tT]><[aA]><[gG]>] ':'\s* $<field-value>=[ [(W)'/']? <opaque-tag> ]
+    }
+    token opaque-tag {
+        \" <opaque-content> \"
+    }
+    # visible chars except double quote
+    token opaque-content {
+        <[\x[21]..\x[FF]]-[\x[22]\x[7F]]>*
+    }
+    token vchars { <[\x[21]..\x[7E]]>+ } # visible ascii
+    token field-vchars { <[\x[21]..\x[FF]]-[\x[7F]]>+ } # visible chars
+    token value {
+        <field-vchars> [ <[\t\x[20]]>* <field-vchars> ]*
+    }
+    token quoted-string {
+        \" <quoted-content> \"
+    }
+    token quoted-content {
+        [<qtd-text> | <quoted-pair>]*
+    }
+    # visible chars plus tab, space, except double quotes and backslash
+    token qtd-text {
+        <[\t\x[20]..\x[FF]]-[\x[22]\x[5C]\x[7F]]>+
+    }
+    # visible chars plus tab, space
+    token quotable-char {
+        <[\t\x[20]..\x[FF]]-[\x[7F]]>
+    }
+    token quoted-pair {
+        \\ <quotable-char>
+    }
+}
+
+class Actions::Strict {
+    method etag ( $/ ) {
+        $*OBJ.field:
+                HTTP::Header::ETag.new:
+                        $<opaque-tag>.made,
+                        weak => $/[0].Bool
+    }
+    method other-field ( $/ ) {
+        my $k = $<field-name>.Str;
+        my @v = $<quoted-string>
+                ?? $<quoted-string>.made
+                !! map *.trim, $<value>.Str.split: ',';
+        if $*OBJ.field: $<field-name> {
+            $*OBJ.push-field: |( $k => @v );
+        } else {
+            $*OBJ.field: |( $k => @v );
+        }
+    }
+    method opaque-tag ( $/ ) {
+        make $<opaque-content>.Str;
+    }
+    method quoted-string ( $/ ) {
+        make $<quoted-content>.Str;
+    }
+}
+
 our grammar HTTP::Header::Grammar {
     token TOP {
         [ <message-header> \r?\n ]*
@@ -50,12 +133,12 @@ our class HTTP::Header::Actions {
 }
 
 # we want to pass arguments like this: .new(a => 1, b => 2 ...)
-method new(*%fields) {
+method new(Bool $strict = False, *%fields) {
     my @fields = %fields.sort(*.key).map: {
         HTTP::Header::Field.new(:name(.key), :values(.value.list));
     }
 
-    self.bless(:@fields)
+    self.bless(:$strict, :@fields)
 }
 
 proto method field(|) {*}
@@ -79,6 +162,11 @@ multi method field($field) {
     @.fields.first(*.name.lc eq $field-lc)
 }
 
+multi method field ( HTTP::Header::ETag:D $etag ) {
+    @.fields.push: $etag;
+}
+
+
 # initialize fields
 method init-field(*%fields) {
     for %fields.sort(*.key) -> (:key($k), :value($v)) {
@@ -120,13 +208,24 @@ method clear() {
 }
 
 # get header as string
-method Str($eol = "\n") {
+multi method Str(Str $eol is copy = "\n", Bool $strict is copy = False) {
+    $strict ||= $!strict;
+    $eol = $CRLF if $strict;
     @.fields.map({ "$_.name(): {self.field($_.name)}$eol" }).join
 }
+multi method Str (Bool $strict is copy = False) is default {
+    self.Str: "\n", $strict;
+}
 
-method parse($raw) {
-    my $*OBJ = self;
-    HTTP::Header::Grammar.parse($raw, :actions(HTTP::Header::Actions));
+method parse($raw, Bool $strict is copy = False) {
+    $strict ||= $!strict;
+    if $strict {
+        my $*OBJ = self;
+        Grammar::Strict.parse: $raw, actions => Actions::Strict;
+    } else {
+        my $*OBJ = self;
+        HTTP::Header::Grammar.parse($raw, :actions(HTTP::Header::Actions));
+    }
 }
 
 # vim: expandtab shiftwidth=4

lib/HTTP/Header/ETag.rakumod

@@ -0,0 +1,12 @@
+use HTTP::Header::Field;
+
+unit class HTTP::Header::ETag is HTTP::Header::Field;
+
+has Bool:D $.weak is required;
+
+method new ( $value, Bool :$weak ) {
+	self.bless:
+			name => 'ETag',
+			:$weak,
+			values => $value
+}

lib/HTTP/Message.rakumod

@@ -4,6 +4,7 @@ use HTTP::Header;
 use HTTP::MediaType;
 use Encode;
 
+has Bool $.strict is rw;
 has HTTP::Header $.header = HTTP::Header.new;
 has $.content is rw;
 
@@ -12,12 +13,20 @@ has $.protocol is rw = 'HTTP/1.1';
 has Bool $.binary = False;
 has Str  @.text-types;
 
-my $CRLF = "\r\n";
+my constant $CRLF = "\x[0d]\x[0a]";
+my constant $DELIM = $CRLF x 2;
+my constant $STRICT = True; # prepare for assoc. strict to positional strict
 
-method new($content?, *%fields) {
-    my $header = HTTP::Header.new(|%fields);
+multi method new($content, Bool $strict = False, *%fields) {
+    my $header = HTTP::Header.new($strict, |%fields);
 
-    self.bless(:$header, :$content);
+    self.bless(:$header, :$content, :$strict);
+}
+
+multi method new(Bool $strict = False, *%fields) is default {
+    my $header = HTTP::Header.new($strict, |%fields);
+
+    self.bless(:$header, :$strict);
 }
 
 method add-content($content) {
@@ -103,6 +112,17 @@ method is-text(--> Bool:D) {
 
 method is-binary(--> Bool:D) { !self.is-text }
 
+#| multiple transfer-codings can be listed; chunked should be last
+#| https://datatracker.ietf.org/doc/html/rfc2616#section-14.41
+#| https://datatracker.ietf.org/doc/html/rfc7230#section-4
+multi method is-chunked ( HTTP::Header $header --> Bool:D ) {
+    my $enc = $header.field('Transfer-Encoding');
+    so $enc and $enc.values.tail.trim.lc.ends-with: 'chunked'
+}
+multi method is-chunked(--> Bool:D) {
+    self.is-chunked: $!header;
+}
+
 method content-encoding() {
     $!header.field('Content-Encoding');
 }
@@ -180,48 +200,87 @@ method clear {
     $.content = ''
 }
 
-method parse($raw_message) {
-    my @lines = $raw_message.split(/$CRLF/);
-
-    my ($first, $second, $third) = @lines.shift.split(/\s+/);
+# parsing content with embedded CRLFs NYI
+#   it would require taking encoding into account and working with Blobs
+method !parse-content-strict ( $content ) {
+    if self.is-chunked {
+        # technically incorrect - content allowed to contain embedded CRLFs
+        my @lines = $content.split: $CRLF;
+        # pop zero-length Str that occurs after last chunk
+        #   what to do if this doesn't happen?
+        @lines.pop if @lines %2;
+        @lines = grep so *,
+                    @lines.map:
+                            -> $d, $s { $d ~~ /^<[0..9]>/ ?? $s !! Str }
+                ;
+        $.content = @lines.join;
+    } else {
+        $.content = $content;
+    }
+}
 
+method !parse-first ($raw_message, --> Str) {
+    my ( $start-line, $rest ) = $raw_message.split: $CRLF, 2;
+    my ($first, $second, $third) = $start-line.split(/\s+/);
     if $third.index('/') { # is a request
         $.protocol = $third;
     }
     else {               # is a response
         $.protocol = $first;
     }
+    $rest;
+}
 
-    loop {
-        last until @lines;
-
-        my $line = @lines.shift;
-        if $line {
-            my ($k, $v) = $line.split(/\:\s*/, 2);
-            if $k and $v {
-                if $.header.field($k) {
-                    $.header.push-field: |($k => $v.split(',')>>.trim);
-                } else {
-                    $.header.field: |($k => $v.split(',')>>.trim);
-                }
+method !parse-header($header) {
+    my @lines = $header.split($CRLF);
+    for @lines -> $line {
+        my ($k, $v) = $line.split(/\:\s*/, 2);
+        if $k and $v {
+            if $!header.field($k) {
+                $!header.push-field: |($k => $v.split(',')>>.trim);
+            } else {
+                $!header.field: |($k => $v.split(',')>>.trim);
             }
-        } else {
-            $.content = @lines.grep({ $_ }).join("\n");
-            last;
         }
+        # else warn?
     }
+}
+
+method !parse-header-strict($header) {
+    $!header.parse($header, $STRICT);
+}
 
+method parse($raw_message, Bool $strict is copy = False) {
+    $strict ||= $!strict;
+    my $rest = self!parse-first($raw_message);
+    my ($header, $content) = $rest.split($DELIM, 2);
+    if $strict {
+        $!header.parse($header, $STRICT);
+        self!parse-content-strict($content) if $content;
+    } else {
+        self!parse-header($header);
+        $!content = join "\n", grep so *, $content.split: $CRLF;
+    }
     self
 }
 
-method Str($eol = "\n", :$debug, Bool :$bin) {
+multi method Str(Str $eol is copy = "\n", Bool $strict is copy = False, :$debug, Bool :$bin) {
+    $strict ||= $!strict;
+    $eol = $CRLF if $strict;
+
     my constant $max_size = 300;
-    my $s = $.header.Str($eol);
-    $s ~= $eol if $.content;
+    self.field: Content-Length => ( $!content.?encode or $!content ).bytes.Str
+        if $strict and $!content and not self.is-chunked;
+    my $s = $.header.Str($eol, $strict);
+    $s ~= $eol if $!content and not $strict;
 
     # The :bin will be passed from the H::UA
     if not $bin {
-        $s ~=  $.content ~ $eol if $.content and !$debug;
+        if $strict {
+            $s ~= $CRLF ~ ( $.content || '' );
+        } else {
+            $s ~=  $.content ~ $eol if $.content and !$debug;
+        }
     }
     if $.content and $debug {
         if $bin || self.is-binary {
@@ -237,5 +296,8 @@ method Str($eol = "\n", :$debug, Bool :$bin) {
 
     $s
 }
+multi method Str(Bool $strict is copy = False, :$debug, Bool :$bin) {
+    self.Str: "\n", $strict, :$debug, :$bin;
+}
 
 # vim: expandtab shiftwidth=4