1 files changed, 128 insertions, 0 deletions
diff --git a/stdlib/source/lux/world/net/http/request.lux b/stdlib/source/lux/world/net/http/request.lux
new file mode 100644
index 000000000..fd09628a5
--- /dev/null
+++ b/stdlib/source/lux/world/net/http/request.lux
@@ -0,0 +1,128 @@
+(.module:
+  [lux #*
+   [control
+    pipe
+    ["." monad (#+ do)]
+    [concurrency
+     ["." promise (#+ Promise)]
+     ["." frp]]]
+   [data
+    ["." maybe]
+    ["." error (#+ Error)]
+    ["." number]
+    ["." text
+     format
+     ["." encoding]]
+    [format
+     ["." json (#+ JSON)]
+     ["." context (#+ Context Property)]]
+    [collection
+     [list ("list/." Functor<List> Fold<List>)]
+     ["." dictionary]]]
+   [world
+    ["." binary (#+ Binary)]]]
+  ["." // (#+ Body Response Server)
+   ["//." response]
+   ["//." query]
+   ["//." cookie]])
+
+(def: (merge inputs)
+  (-> (List Binary) Binary)
+  (let [[_ output] (error.assume
+                    (monad.fold error.Monad<Error>
+                                (function (_ input [offset output])
+                                  (let [amount (binary.size input)]
+                                    (:: error.Functor<Error> map (|>> [(n/+ amount offset)])
+                                        (binary.copy amount 0 input offset output))))
+                                [0 (|> inputs
+                                       (list/map binary.size)
+                                       (list/fold n/+ 0)
+                                       binary.create)]
+                                inputs))]
+    output))
+
+(def: (read-text-body body)
+  (-> Body (Promise (Error Text)))
+  (do promise.Monad<Promise>
+    [blobs (frp.consume body)]
+    (wrap (encoding.from-utf8 (merge blobs)))))
+
+(def: failure (//response.bad-request ""))
+
+(def: #export (json server)
+  (-> (-> JSON Server) Server)
+  (function (_ request)
+    (let [[identification protocol resource message] 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)
+          
+          (#error.Failure error)
+          (promise.resolved ..failure))))))
+
+(def: #export (text server)
+  (-> (-> Text Server) Server)
+  (function (_ request)
+    (let [[identification protocol resource message] request]
+      (do promise.Monad<Promise>
+        [?raw (read-text-body (get@ #//.body message))]
+        (case ?raw
+          (#error.Success content)
+          (server 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)
+          [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]
+                     input]))
+        (#error.Success [request input])
+        (server input request)
+        
+        (#error.Failure error)
+        (promise.resolved ..failure)))))
+
+(def: #export (form property server)
+  (All [a] (-> (Property a) (-> a Server) Server))
+  (function (_ request)
+    (let [[identification protocol resource message] request]
+      (do promise.Monad<Promise>
+        [?body (read-text-body (get@ #//.body message))]
+        (case (do error.Monad<Error>
+                [body ?body
+                 form (//query.parameters body)]
+                (context.run form property))
+          (#error.Success input)
+          (server input request)
+          
+          (#error.Failure error)
+          (promise.resolved ..failure))))))
+
+(def: #export (cookies property server)
+  (All [a] (-> (Property a) (-> a Server) Server))
+  (function (_ request)
+    (let [[identification protocol resource message] request]
+      (case (do error.Monad<Error>
+              [cookies (|> (get@ #//.headers message)
+                           (dictionary.get "Cookie")
+                           (maybe.default "")
+                           //cookie.get)]
+              (context.run cookies property))
+        (#error.Success input)
+        (server input request)
+        
+        (#error.Failure error)
+        (promise.resolved ..failure)))))