From 8f325e6cbc551abd19494d6f6ae9a6790a12bfc4 Mon Sep 17 00:00:00 2001
From: James Raspass <jraspass@gmail.com>
Date: Tue, 24 Aug 2021 12:21:04 +0100
Subject: [PATCH] Allow form to be rendered with a "get" method attr

Forbid "file" elements when doing so and omit CSRF token.
---
 lib/Cro/WebApp/Form.pm6  | 24 +++++++++++++++++++++---
 resources/prelude.crotmp | 14 +++++++-------
 t/form-get.t             | 21 +++++++++++++++++++++
 3 files changed, 49 insertions(+), 10 deletions(-)
 create mode 100644 t/form-get.t

diff --git a/lib/Cro/WebApp/Form.pm6 b/lib/Cro/WebApp/Form.pm6
index 3e64264..fc3abd5 100644
--- a/lib/Cro/WebApp/Form.pm6
+++ b/lib/Cro/WebApp/Form.pm6
@@ -247,6 +247,16 @@ class Cro::WebApp::Form::ValidationState {
     }
 }
 
+#| Thrown when a form containing a file element is rendered with a GET method.
+class X::Cro::WebApp::Form::FileInGET is Exception {
+    has Str $.form    is required;
+    has Str $.element is required;
+
+    method message {
+        "Form '$.form' cannot contain element '$.element' with 'GET' method";
+    }
+}
+
 #| A role to be composed into Cro web application form objects, providing the key form
 #| functionality.
 role Cro::WebApp::Form {
@@ -256,6 +266,9 @@ role Cro::WebApp::Form {
     #| Cached rendered data, in case it is asked for multiple times.
     has $!cached-render-data;
 
+    #| The HTTP method for which $!cached-render-data is valid.
+    has $!cached-render-method;
+
     #| Computed validation state.
     has Cro::WebApp::Form::ValidationState $!validation-state;
 
@@ -374,8 +387,10 @@ role Cro::WebApp::Form {
 
     #| Produce a description of the form and its content for use in rendering
     #| the form to HTML.
-    method HTML-RENDER-DATA(--> Hash) {
-        .return with $!cached-render-data;
+    method HTML-RENDER-DATA(:$method where "get"|"post" = "post" --> Hash) {
+        return $!cached-render-data
+            if $!cached-render-data.defined && $!cached-render-method eq $method;
+
         my @controls;
         my %validation-by-control;
         with $!validation-state {
@@ -386,6 +401,8 @@ role Cro::WebApp::Form {
         for self.^attributes.grep(*.has_accessor) -> Attribute $attr {
             my ($control-type, %properties) = self!calculate-control-type($attr);
             my $name = $attr.name.substr(2);
+            die X::Cro::WebApp::Form::FileInGET.new :form(::?CLASS.^name) :element($name)
+                if $control-type eq 'file' && $method eq 'get';
             my %control =
                     :$name,
                     label => self!calculate-label($attr),
@@ -399,12 +416,13 @@ role Cro::WebApp::Form {
             }
             @controls.push(%control);
         }
-        self!add-csrf-protection(@controls);
+        self!add-csrf-protection(@controls) if $method eq 'post';
         my %enctype = any(self.^attributes.map(*.?webapp-form-type).grep(*.defined)) eq 'file' ?? enctype => "multipart/form-data" !! Empty;
         my %rendered := { :@controls, was-validated => $!validation-state.defined, |%enctype };
         if %validation-by-control{''} -> @errors {
             %rendered<validation-errors> = [@errors.map(*.message)];
         }
+        $!cached-render-method = $method;
         return $!cached-render-data := %rendered;
     }
 
diff --git a/resources/prelude.crotmp b/resources/prelude.crotmp
index 86a2b77..f5e1b8d 100644
--- a/resources/prelude.crotmp
+++ b/resources/prelude.crotmp
@@ -21,12 +21,12 @@
   </?>
 </:>
 
-<:sub form-errors($_, :$form-errors-class, :$form-errors-text)>
-  <?.HTML-RENDER-DATA.<validation-errors>>
+<:sub form-errors($_, :$form-errors-class, :$form-errors-text, :$method)>
+  <?.HTML-RENDER-DATA(:$method).<validation-errors>>
     <div<&class($form-errors-class)>>
       <?$form-errors-text><$form-errors-text></?>
       <ul>
-        <@HTML-RENDER-DATA.<validation-errors>>
+        <@HTML-RENDER-DATA(:$method).<validation-errors>>
           <li><$_></li>
         </@>
       </ul>
@@ -39,10 +39,10 @@
                :$novalidate, :$was-validated-class, :$is-invalid-class,
                :$invalid-feedback-class, :$form-errors-class, :$form-errors-text,
                :$help-class, :$submit-button-class, :$submit-button-text,
-               :$action, :$name)>
-  <form name="<?$name><$name></?><!$name><.GENERATE-NAME></!>" method="post"<?$action> action="<$action>"</?><?$novalidate> novalidate</?><?{ .<was-validated> && $was-validated-class }> class="<$was-validated-class>"</?><?.HTML-RENDER-DATA.enctype> enctype="<.HTML-RENDER-DATA.enctype>"</?>>
-  <&form-errors($_, :$form-errors-class, :$form-errors-text)>
-  <@HTML-RENDER-DATA.controls>
+               :$action, :$name, :$method = 'post')>
+  <form name="<?$name><$name></?><!$name><.GENERATE-NAME></!>" method="<$method>"<?$action> action="<$action>"</?><?$novalidate> novalidate</?><?{ .<was-validated> && $was-validated-class }> class="<$was-validated-class>"</?><?.HTML-RENDER-DATA(:$method).enctype> enctype="<.HTML-RENDER-DATA(:$method).enctype>"</?>>
+  <&form-errors($_, :$form-errors-class, :$form-errors-text, :$method)>
+  <@HTML-RENDER-DATA(:$method).controls>
     <?{ .type eq 'text' || .type eq 'email' || .type eq 'search' || .type eq 'url' || .type eq 'tel' }>
       <div<&class($input-group-class)>>
         <label for="<.name>"<&class($input-label-class)>><.label></label>
diff --git a/t/form-get.t b/t/form-get.t
new file mode 100644
index 0000000..c7260ea
--- /dev/null
+++ b/t/form-get.t
@@ -0,0 +1,21 @@
+use Cro::WebApp::Form;
+use Cro::WebApp::Template::Repository;
+use Test;
+
+class Search does Cro::WebApp::Form { has $.query is search }
+class Upload does Cro::WebApp::Form { has $.photo is file   }
+
+constant template = parse-template ｢<&form($_, :method('get'))>｣;
+
+with template.render: Search.empty {
+    like $_, / 'method="get"' /, 'Form method is GET';
+
+    unlike $_, / '__CSRF_TOKEN' /, 'CSRF token is omitted';
+}
+
+throws-like { template.render: Upload.empty },
+    X::Cro::WebApp::Form::FileInGET,
+    :message("Form 'Upload' cannot contain element 'photo' with 'GET' method"),
+    'File element in a GET form dies';
+
+done-testing;