Merge pull request #147 from croservices/IRI-handling

Iri handling
croservices · Aug 4, 2021 · 0cc4cd7 · 0cc4cd7
2 parents 445bf95 + ea579aa
commit 0cc4cd7
Show file tree

Hide file tree

Showing 6 changed files with 137 additions and 78 deletions.
diff --git a/META6.json b/META6.json
@@ -61,14 +61,16 @@
     "Cro::HTTP::RequestSerializer": "lib/Cro/HTTP/RequestSerializer.pm6",
     "Cro::HTTP::Response": "lib/Cro/HTTP/Response.pm6",
     "Cro::HTTP::ResponseParser": "lib/Cro/HTTP/ResponseParser.pm6",
+    "Cro::ResourceIdentifier::HTTP": "lib/Cro/ResourceIdentifier/HTTP.pm6",
     "Cro::HTTP::ResponseSerializer": "lib/Cro/HTTP/ResponseSerializer.pm6",
     "Cro::HTTP::Router": "lib/Cro/HTTP/Router.pm6",
     "Cro::HTTP::Server": "lib/Cro/HTTP/Server.pm6",
     "Cro::HTTP::Session::IdGenerator": "lib/Cro/HTTP/Session/IdGenerator.pm6",
     "Cro::HTTP::Session::InMemory": "lib/Cro/HTTP/Session/InMemory.pm6",
     "Cro::HTTP::Session::Persistent": "lib/Cro/HTTP/Session/Persistent.pm6",
     "Cro::HTTP::VersionSelector": "lib/Cro/HTTP/VersionSelector.pm6",
-    "Cro::Uri::HTTP": "lib/Cro/Uri/HTTP.pm6"
+    "Cro::Uri::HTTP": "lib/Cro/Uri/HTTP.pm6",
+    "Cro::Iri::HTTP": "lib/Cro/Iri/HTTP.pm6"
   },
   "license": "Artistic-2.0",
   "tags": [

diff --git a/lib/Cro/HTTP/Client.pm6 b/lib/Cro/HTTP/Client.pm6
@@ -15,6 +15,8 @@ use Cro::HTTP2::ResponseParser;
 use Cro::TCP;
 use Cro::TLS;
 use Cro::Uri;
+use Cro::Iri;
+use Cro::Iri::HTTP;
 use Cro;
 
 my class ResponseParserExtension is ParserExtension {
@@ -339,15 +341,18 @@ class Cro::HTTP::Client {
                 die X::Cro::HTTP::Client::InvalidVersion.new;
             }
         }
-        my sub wrap-uri($uri) {
-            with $uri {
-                when Cro::Uri { $uri }
-                default { Cro::Uri::HTTP.parse(~$uri); }
-            }
+
+        $!base-uri = self!wrap-uri($_) with $base-uri;
+        $!http-proxy = self!wrap-uri($_) with $http-proxy;
+        $!https-proxy = self!wrap-uri($_) with $https-proxy;
+    }
+
+    method !wrap-uri($uri) {
+        with $uri {
+            when Cro::Uri { $uri; }
+            when Cro::Iri { $uri.to-uri; }
+            default { Cro::Iri::HTTP.parse(~$uri).to-uri; }
         }
-        $!base-uri = wrap-uri($_) with $base-uri;
-        $!http-proxy = wrap-uri($_) with $http-proxy;
-        $!https-proxy = wrap-uri($_) with $https-proxy;
     }
 
     #| Make a HTTP GET request to the specified URL. Returns a C<Promise>
@@ -515,7 +520,7 @@ class Cro::HTTP::Client {
 
         my $parsed-url = self && $!base-uri
             ?? $!base-uri.add($url)
-            !! Cro::Uri::HTTP.parse($url);
+            !! self!wrap-uri($url);
         my $http = self ?? $!http // %options<http> !! %options<http>;
         with $http {
             unless $_ eq '1.1' || $_ eq '2' || $_ eqv <1.1 2> {

diff --git a/lib/Cro/Iri/HTTP.pm6 b/lib/Cro/Iri/HTTP.pm6
@@ -0,0 +1,35 @@
+use Cro::Uri :decode-percents, :encode-percents;
+use Cro::HTTP::MultiValue;
+use Cro::Uri::HTTP;
+use Cro::Iri;
+use Cro::ResourceIdentifier::HTTP;
+
+class Cro::Iri::HTTP is Cro::Iri does Cro::ResourceIdentifier::HTTP {
+    grammar Parser is Cro::Iri::GenericParser {
+        proto token request-target { * }
+        token request-target:sym<origin-form> {
+            <iabsolute-path> [ "?" <iquery> ]?
+        }
+
+        token iabsolute-path {
+            [ "/" <isegment> ]+
+        }
+    }
+
+    grammar Actions is Cro::Iri::GenericActions {
+        method request-target:sym<origin-form>($/) {
+            make Cro::Iri::HTTP.bless(
+                path => $<iabsolute-path>.ast,
+                |(query => .ast with $<iquery>)
+            );
+        }
+
+        method iabsolute-path($/) {
+            make ~$/;
+        }
+    }
+
+    method to-uri-http(--> Cro::Uri::HTTP) {
+        Cro::Uri::HTTP.new(:$.path, :$.query)
+    }
+}
diff --git a/lib/Cro/ResourceIdentifier/HTTP.pm6 b/lib/Cro/ResourceIdentifier/HTTP.pm6
@@ -0,0 +1,72 @@
+use Cro::HTTP::MultiValue;
+use Cro::Uri :decode-percents, :encode-percents;
+
+package Cro::ResourceIdentifier::HTTP {
+    #| Decodes a query string part. This involves replacing any +
+    #| characters with spaces, followed by the standard URI decoding
+    #| algorithm.
+    our sub decode-query-string-part(Str $part --> Str) is export(:decode-query-string-part) {
+        decode-percents $part.subst('+', ' ', :g)
+    }
+}
+
+role Cro::ResourceIdentifier::HTTP {
+    has @!cached-query-list;
+    has %!cached-query-hash;
+
+    method query-list() {
+        # Race to compute this. The bind makes it thread-safe to put in place.
+        unless @!cached-query-list {
+            with self.query {
+                @!cached-query-list := list eager .split('&').map: -> $kv {
+                    my @kv := $kv.split('=', 2).list;
+                    Pair.new:
+                            key => Cro::ResourceIdentifier::HTTP::decode-query-string-part(@kv[0]),
+                            value => Cro::ResourceIdentifier::HTTP::decode-query-string-part(@kv[1] // '')
+                }
+            }
+        }
+        @!cached-query-list
+    }
+
+    method query-hash() {
+        # Race to compute this. The bind at the end makes it thread-safe to
+        # put it in place, as opposed to an assignment which would not be.
+        unless %!cached-query-hash {
+            my %query-hash;
+            with self.query {
+                for .split('&') -> $kv {
+                    my @kv := $kv.split('=', 2).list;
+                    my $key = Cro::ResourceIdentifier::HTTP::decode-query-string-part(@kv[0]);
+                    my $value = Cro::ResourceIdentifier::HTTP::decode-query-string-part(@kv[1] // '');
+                    with %query-hash{$key} -> $existing {
+                        %query-hash{$key} = Cro::HTTP::MultiValue.new(
+                            $existing ~~ Cro::HTTP::MultiValue
+                                    ?? $existing.Slip
+                                    !! $existing,
+                            $value
+                        );
+                    }
+                    else {
+                        %query-hash{$key} = $value;
+                    }
+                }
+            }
+            %!cached-query-hash := %query-hash;
+        }
+        %!cached-query-hash
+    }
+
+    #| Encodes the specified query string parameters and returns a new URI that incorporates
+    #| them. Any existing query string parameters will be retained.
+    method add-query(*@pairs, *%named-paris) {
+        my @parts;
+        if self.query -> $existing {
+            @parts.push($existing);
+        }
+        for flat @pairs, %named-paris.pairs {
+            @parts.push(encode-percents(.key.Str) ~ '=' ~ encode-percents(.value.Str));
+        }
+        self.add('?' ~ @parts.join("&"))
+    }
+}
diff --git a/lib/Cro/Uri/HTTP.pm6 b/lib/Cro/Uri/HTTP.pm6
@@ -1,10 +1,11 @@
-use Cro::Uri :decode-percents, :encode-percents;
 use Cro::HTTP::MultiValue;
+use Cro::ResourceIdentifier::HTTP;
 
-class Cro::Uri::HTTP is Cro::Uri {
-    has @!cached-query-list;
-    has %!cached-query-hash;
+package EXPORT::decode-query-string-part {
+    our &decode-query-string-part = &Cro::ResourceIdentifier::HTTP::decode-query-string-part;
+}
 
+class Cro::Uri::HTTP is Cro::Uri does Cro::ResourceIdentifier::HTTP {
     grammar Parser is Cro::Uri::GenericParser {
         proto token request-target { * }
         token request-target:sym<origin-form> {
@@ -37,67 +38,4 @@ class Cro::Uri::HTTP is Cro::Uri {
             die X::Cro::Uri::ParseError.new(uri-string => $target)
         }
     }
-
-    method query-list() {
-        # Race to compute this. The bind makes it thread-safe to put in place.
-        unless @!cached-query-list {
-            with self.query {
-                @!cached-query-list := list eager .split('&').map: -> $kv {
-                    my @kv := $kv.split('=', 2).list;
-                    Pair.new:
-                            key => decode-query-string-part(@kv[0]),
-                            value => decode-query-string-part(@kv[1] // '')
-                }
-            }
-        }
-        @!cached-query-list
-    }
-
-    method query-hash() {
-        # Race to compute this. The bind at the end makes it thread-safe to
-        # put it in place, as opposed to an assignment which would not be.
-        unless %!cached-query-hash {
-            my %query-hash;
-            with self.query {
-                for .split('&') -> $kv {
-                    my @kv := $kv.split('=', 2).list;
-                    my $key = decode-query-string-part(@kv[0]);
-                    my $value = decode-query-string-part(@kv[1] // '');
-                    with %query-hash{$key} -> $existing {
-                        %query-hash{$key} = Cro::HTTP::MultiValue.new(
-                            $existing ~~ Cro::HTTP::MultiValue
-                                ?? $existing.Slip
-                                !! $existing,
-                            $value
-                        );
-                    }
-                    else {
-                        %query-hash{$key} = $value;
-                    }
-                }
-            }
-            %!cached-query-hash := %query-hash;
-        }
-        %!cached-query-hash
-    }
-
-    #| Encodes the specified query string parameters and returns a new URI that incorporates
-    #| them. Any existing query string parameters will be retained.
-    method add-query(*@pairs, *%named-paris) {
-        my @parts;
-        if self.query -> $existing {
-            @parts.push($existing);
-        }
-        for flat @pairs, %named-paris.pairs {
-            @parts.push(encode-percents(.key.Str) ~ '=' ~ encode-percents(.value.Str));
-        }
-        self.add('?' ~ @parts.join("&"))
-    }
-}
-
-#| Decodes a query string part. This involves replacing any +
-#| characters with spaces, followed by the standard URI decoding
-#| algorithm.
-sub decode-query-string-part(Str $part --> Str) is export(:decode-query-string-part) {
-    decode-percents $part.subst('+', ' ', :g)
-}
+}
diff --git a/t/http-client.t b/t/http-client.t
@@ -321,6 +321,13 @@ constant %key-cert := {
         is await($resp.body-text), 'TEST', 'Body text is correct';
     }
 
+    given await Cro::HTTP::Client.get("$base/query?value=تست") -> $resp {
+        ok $resp ~~ Cro::HTTP::Response, 'Accepts an IRI';
+        is $resp.status, 200, 'Status is 200';
+        like $resp.header('Content-type'), /text\/plain/, 'Correct content type';
+        is await($resp.body-text), 'تست', 'Body text is correct';
+    }
+
     given await Cro::HTTP::Client.get("$base/query") -> $resp {
         ok $resp ~~ Cro::HTTP::Response, 'Got a response back from GET /query';
         is $resp.status, 200, 'Status is 200';