Added integrity/security concerns when dealing with HTTP servers.

5 files changed, 44 insertions, 37 deletions

diff --git a/stdlib/source/lux/control/security/taint.lux b/stdlib/source/lux/control/security/taint.lux
index 9234baa97..b78351b38 100644
--- a/stdlib/source/lux/control/security/taint.lux
+++ b/stdlib/source/lux/control/security/taint.lux
@@ -26,7 +26,9 @@
     (validator (:representation dirty)))
 
   (def: #export trust
-    {#.doc (doc "Trusts a (previously thought as) dirty/untrustworthy value.")}
+    {#.doc (doc "Trusts a (previously thought as) dirty/untrustworthy value."
+                "Only use this function if you know what you are doing."
+                "Trusting a value that hasn't been validated opens a security vulnerability.")}
     (All [a] (-> (Dirty a) a))
     (|>> :representation))
 
diff --git a/stdlib/source/lux/world/net/http.lux b/stdlib/source/lux/world/net/http.lux
index b518858a6..7fcdb5244 100644
--- a/stdlib/source/lux/world/net/http.lux
+++ b/stdlib/source/lux/world/net/http.lux
@@ -3,7 +3,9 @@
    [control
     [concurrency
      [promise (#+ Promise)]
-     [frp (#+ Channel)]]]
+     [frp (#+ Channel)]]
+    [security
+     [taint (#+ Dirty)]]]
    [data
     [format
      [context (#+ Context)]]]
@@ -58,9 +60,7 @@
 
 (type: #export Resource
   {#method Method
-   #uri    URI
-   #query  Context
-   #form   (Maybe Context)})
+   #uri    URI})
 
 (type: #export Message
   {#headers Context
@@ -73,4 +73,4 @@
   [Status Message])
 
 (type: #export Server
-  (-> Request (Promise Response)))
+  (-> (Dirty Request) (Promise Response)))
diff --git a/stdlib/source/lux/world/net/http/request.lux b/stdlib/source/lux/world/net/http/request.lux
index fd09628a5..9db7e6973 100644
--- a/stdlib/source/lux/world/net/http/request.lux
+++ b/stdlib/source/lux/world/net/http/request.lux
@@ -5,7 +5,9 @@
     ["." monad (#+ do)]
     [concurrency
      ["." promise (#+ Promise)]
-     ["." frp]]]
+     ["." frp]]
+    [security
+     ["." taint (#+ Dirty)]]]
    [data
     ["." maybe]
     ["." error (#+ Error)]
@@ -50,55 +52,56 @@
 (def: failure (//response.bad-request ""))
 
 (def: #export (json server)
-  (-> (-> JSON Server) Server)
+  (-> (-> (Dirty JSON) Server) Server)
   (function (_ request)
-    (let [[identification protocol resource message] request]
+    (let [[identification protocol resource message] (taint.trust request)]
       (do promise.Monad<Promise>
         [?raw (read-text-body (get@ #//.body message))]
         (case (do error.Monad<Error>
                 [raw ?raw]
                 (:: json.Codec<Text,JSON> decode raw))
           (#error.Success content)
-          (server content request)
+          (server (taint.taint content) request)
           
           (#error.Failure error)
           (promise.resolved ..failure))))))
 
 (def: #export (text server)
-  (-> (-> Text Server) Server)
+  (-> (-> (Dirty Text) Server) Server)
   (function (_ request)
-    (let [[identification protocol resource message] request]
+    (let [[identification protocol resource message] (taint.trust request)]
       (do promise.Monad<Promise>
         [?raw (read-text-body (get@ #//.body message))]
         (case ?raw
           (#error.Success content)
-          (server content request)
+          (server (taint.taint content) request)
           
           (#error.Failure error)
           (promise.resolved ..failure))))))
 
 (def: #export (query property server)
-  (All [a] (-> (Property a) (-> a Server) Server))
-  (function (_ [identification protocol resource message])
-    (let [full (get@ #//.uri resource)
+  (All [a] (-> (Property a) (-> (Dirty a) Server) Server))
+  (function (_ request)
+    (let [[identification protocol resource message] (taint.trust request)
+          full (get@ #//.uri resource)
           [uri query] (|> full
                           (text.split-with "?")
                           (maybe.default [full ""]))]
       (case (do error.Monad<Error>
               [query (//query.parameters query)
                input (context.run query property)]
-              (wrap [[identification protocol (set@ #//.uri uri resource) message]
+              (wrap [(taint.taint [identification protocol (set@ #//.uri uri resource) message])
                      input]))
         (#error.Success [request input])
-        (server input request)
+        (server (taint.taint input) request)
         
         (#error.Failure error)
         (promise.resolved ..failure)))))
 
 (def: #export (form property server)
-  (All [a] (-> (Property a) (-> a Server) Server))
+  (All [a] (-> (Property a) (-> (Dirty a) Server) Server))
   (function (_ request)
-    (let [[identification protocol resource message] request]
+    (let [[identification protocol resource message] (taint.trust request)]
       (do promise.Monad<Promise>
         [?body (read-text-body (get@ #//.body message))]
         (case (do error.Monad<Error>
@@ -106,15 +109,15 @@
                  form (//query.parameters body)]
                 (context.run form property))
           (#error.Success input)
-          (server input request)
+          (server (taint.taint input) request)
           
           (#error.Failure error)
           (promise.resolved ..failure))))))
 
 (def: #export (cookies property server)
-  (All [a] (-> (Property a) (-> a Server) Server))
+  (All [a] (-> (Property a) (-> (Dirty a) Server) Server))
   (function (_ request)
-    (let [[identification protocol resource message] request]
+    (let [[identification protocol resource message] (taint.trust request)]
       (case (do error.Monad<Error>
               [cookies (|> (get@ #//.headers message)
                            (dictionary.get "Cookie")
@@ -122,7 +125,7 @@
                            //cookie.get)]
               (context.run cookies property))
         (#error.Success input)
-        (server input request)
+        (server (taint.taint input) request)
         
         (#error.Failure error)
         (promise.resolved ..failure)))))
diff --git a/stdlib/source/lux/world/net/http/response.lux b/stdlib/source/lux/world/net/http/response.lux
index 33bf821d5..cac7866af 100644
--- a/stdlib/source/lux/world/net/http/response.lux
+++ b/stdlib/source/lux/world/net/http/response.lux
@@ -8,7 +8,7 @@
      format
      ["." encoding]]
     [format
-     ["." html (#+ HTML)]
+     ["." html]
      ["." css (#+ CSS)]
      ["." context]]]
    ["." io]
@@ -60,7 +60,7 @@
   (|>> encoding.to-utf8 (..ok mime.text)))
 
 (def: #export html
-  (-> (HTML Any) Response)
+  (-> html.Document Response)
   (|>> html.html encoding.to-utf8 (..ok mime.html)))
 
 (def: #export css
diff --git a/stdlib/source/lux/world/net/http/route.lux b/stdlib/source/lux/world/net/http/route.lux
index 188508a5d..e430b9739 100644
--- a/stdlib/source/lux/world/net/http/route.lux
+++ b/stdlib/source/lux/world/net/http/route.lux
@@ -3,7 +3,9 @@
    [control
     [monad (#+ do)]
     [concurrency
-     ["." promise]]]
+     ["." promise]]
+    [security
+     ["." taint]]]
    [data
     ["." maybe]
     ["." text ("text/." Equivalence<Text>)]]]
@@ -15,7 +17,7 @@
   [(def: #export (<name> server)
      (-> Server Server)
      (function (_ request)
-       (let [[identification protocol resource message] request]
+       (let [[identification protocol resource message] (taint.trust request)]
          (case (get@ #//.scheme protocol)
            <scheme>
            (server request)
@@ -31,7 +33,7 @@
   [(def: #export (<name> server)
      (-> Server Server)
      (function (_ request)
-       (let [[identification protocol resource message] request]
+       (let [[identification protocol resource message] (taint.trust request)]
          (case (get@ #//.method resource)
            <method>
            (server request)
@@ -53,7 +55,7 @@
 (def: #export (uri path server)
   (-> URI Server Server)
   (function (_ request)
-    (let [[identification protocol resource message] request]
+    (let [[identification protocol resource message] (taint.trust request)]
       (if (text/= path (get@ #//.uri resource))
         (server request)
         (promise.resolved //response.not-found)))))
@@ -61,14 +63,14 @@
 (def: #export (sub path server)
   (-> URI Server Server)
   (function (_ request)
-    (let [[identification protocol resource message] request]
+    (let [[identification protocol resource message] (taint.trust request)]
       (if (text.starts-with? path (get@ #//.uri resource))
-        (server [identification
-                 protocol
-                 (update@ #//.uri
-                          (|>> (text.clip' (text.size path)) maybe.assume)
-                          resource)
-                 message])
+        (server (taint.taint [identification
+                              protocol
+                              (update@ #//.uri
+                                       (|>> (text.clip' (text.size path)) maybe.assume)
+                                       resource)
+                              message]))
         (promise.resolved //response.not-found)))))
 
 (def: #export (or primary alternative)