diff options
Diffstat (limited to '')
-rw-r--r-- | stdlib/source/library/lux/world/net/http.lux | 80 | ||||
-rw-r--r-- | stdlib/source/library/lux/world/net/http/client.lux | 227 | ||||
-rw-r--r-- | stdlib/source/library/lux/world/net/http/cookie.lux | 88 | ||||
-rw-r--r-- | stdlib/source/library/lux/world/net/http/header.lux | 35 | ||||
-rw-r--r-- | stdlib/source/library/lux/world/net/http/mime.lux | 100 | ||||
-rw-r--r-- | stdlib/source/library/lux/world/net/http/query.lux | 65 | ||||
-rw-r--r-- | stdlib/source/library/lux/world/net/http/request.lux | 128 | ||||
-rw-r--r-- | stdlib/source/library/lux/world/net/http/response.lux | 74 | ||||
-rw-r--r-- | stdlib/source/library/lux/world/net/http/route.lux | 74 | ||||
-rw-r--r-- | stdlib/source/library/lux/world/net/http/status.lux | 83 | ||||
-rw-r--r-- | stdlib/source/library/lux/world/net/http/version.lux | 13 |
11 files changed, 967 insertions, 0 deletions
diff --git a/stdlib/source/library/lux/world/net/http.lux b/stdlib/source/library/lux/world/net/http.lux new file mode 100644 index 000000000..8e205e2a0 --- /dev/null +++ b/stdlib/source/library/lux/world/net/http.lux @@ -0,0 +1,80 @@ +(.module: + [library + [lux #* + [control + [try (#+ Try)] + [concurrency + [promise (#+ Promise)] + [frp (#+ Channel)]] + [parser + ["." environment (#+ Environment)]]] + [data + [binary (#+ Binary)]]]] + [// (#+ URL) + [uri (#+ URI)]]) + +(type: #export Version + Text) + +(type: #export Method + #Post + #Get + #Put + #Patch + #Delete + #Head + #Connect + #Options + #Trace) + +(type: #export Port + Nat) + +(type: #export Status + Nat) + +(type: #export Headers + Environment) + +(def: #export empty + Headers + environment.empty) + +(type: #export Header + (-> Headers Headers)) + +(type: #export (Body !) + (-> (Maybe Nat) (! (Try [Nat Binary])))) + +(type: #export Scheme + #HTTP + #HTTPS) + +(type: #export Address + {#port Port + #host Text}) + +(type: #export Identification + {#local Address + #remote Address}) + +(type: #export Protocol + {#version Version + #scheme Scheme}) + +(type: #export Resource + {#method Method + #uri URI}) + +(type: #export (Message !) + {#headers Headers + #body (Body !)}) + +(type: #export (Request !) + [Identification Protocol Resource (Message !)]) + +(type: #export (Response !) + [Status (Message !)]) + +(type: #export (Server !) + (-> (Request !) (! (Response !)))) diff --git a/stdlib/source/library/lux/world/net/http/client.lux b/stdlib/source/library/lux/world/net/http/client.lux new file mode 100644 index 000000000..5a7a93e31 --- /dev/null +++ b/stdlib/source/library/lux/world/net/http/client.lux @@ -0,0 +1,227 @@ +(.module: + [library + [lux #* + ["@" target] + ["." ffi] + [abstract + ["." monad (#+ do)]] + [control + [pipe (#+ case>)] + ["." io (#+ IO)] + ["." try (#+ Try)] + [concurrency + ["." promise (#+ Promise)]]] + [data + ["." binary (#+ Binary)] + ["." maybe ("#\." functor)] + ["." text] + [collection + ["." dictionary]]] + [math + [number + ["n" nat] + ["i" int]]]]] + ["." // + [// (#+ URL)]]) + +(interface: #export (Client !) + (: (-> //.Method URL //.Headers (Maybe Binary) + (! (Try (//.Response !)))) + request)) + +(template [<name> <method>] + [(def: #export (<name> url headers data client) + (All [!] + (-> URL //.Headers (Maybe Binary) (Client !) + (! (Try (//.Response !))))) + (\ client request <method> url headers data))] + + [post #//.Post] + [get #//.Get] + [put #//.Put] + [patch #//.Patch] + [delete #//.Delete] + [head #//.Head] + [connect #//.Connect] + [options #//.Options] + [trace #//.Trace] + ) + +(def: default_buffer_size + (n.* 1,024 1,024)) + +(def: empty_body + [Nat Binary] + [0 (binary.create 0)]) + +(def: (body_of data) + (-> Binary [Nat Binary]) + [(binary.size data) data]) + +(with_expansions [<jvm> (as_is (ffi.import: java/lang/String) + + (ffi.import: java/lang/AutoCloseable + ["#::." + (close [] #io #try void)]) + + (ffi.import: java/io/InputStream) + + (ffi.import: java/io/OutputStream + ["#::." + (flush [] #io #try void) + (write [[byte]] #io #try void)]) + + (ffi.import: java/net/URLConnection + ["#::." + (setDoOutput [boolean] #io #try void) + (setRequestProperty [java/lang/String java/lang/String] #io #try void) + (getInputStream [] #io #try java/io/InputStream) + (getOutputStream [] #io #try java/io/OutputStream) + (getHeaderFieldKey [int] #io #try #? java/lang/String) + (getHeaderField [int] #io #try #? java/lang/String)]) + + (ffi.import: java/net/HttpURLConnection + ["#::." + (setRequestMethod [java/lang/String] #io #try void) + (getResponseCode [] #io #try int)]) + + (ffi.import: java/net/URL + ["#::." + (new [java/lang/String]) + (openConnection [] #io #try java/net/URLConnection)]) + + (ffi.import: java/io/BufferedInputStream + ["#::." + (new [java/io/InputStream]) + (read [[byte] int int] #io #try int)]) + + (def: jvm_method + (-> //.Method Text) + (|>> (case> #//.Post "POST" + #//.Get "GET" + #//.Put "PUT" + #//.Patch "PATCH" + #//.Delete "DELETE" + #//.Head "HEAD" + #//.Connect "CONNECT" + #//.Options "OPTIONS" + #//.Trace "TRACE"))) + + (def: (default_body input) + (-> java/io/BufferedInputStream (//.Body IO)) + (|>> (maybe\map (|>> [true])) + (maybe.default [false ..default_buffer_size]) + (case> [_ 0] + (do (try.with io.monad) + [_ (java/lang/AutoCloseable::close input)] + (wrap ..empty_body)) + + [partial? buffer_size] + (let [buffer (binary.create buffer_size)] + (if partial? + (loop [so_far +0] + (do {! (try.with io.monad)} + [#let [remaining (i.- so_far (.int buffer_size))] + bytes_read (java/io/BufferedInputStream::read buffer so_far remaining input)] + (case bytes_read + -1 (do ! + [_ (java/lang/AutoCloseable::close input)] + (wrap [(.nat so_far) buffer])) + +0 (recur so_far) + _ (if (i.= remaining bytes_read) + (wrap [buffer_size buffer]) + (recur (i.+ bytes_read so_far)))))) + (loop [so_far +0 + output (\ binary.monoid identity)] + (do {! (try.with io.monad)} + [#let [remaining (i.- so_far (.int buffer_size))] + bytes_read (java/io/BufferedInputStream::read buffer so_far remaining input)] + (case bytes_read + -1 (do ! + [_ (java/lang/AutoCloseable::close input)] + (case so_far + +0 (wrap (..body_of output)) + _ (|> buffer + (binary.slice 0 (.nat so_far)) + (\ try.functor map + (|>> (\ binary.monoid compose output) + ..body_of)) + (\ io.monad wrap)))) + +0 (recur so_far output) + _ (if (i.= remaining bytes_read) + (recur +0 + (\ binary.monoid compose output buffer)) + (recur (i.+ bytes_read so_far) + output)))))))))) + + (def: (default_headers connection) + (-> java/net/HttpURLConnection (IO (Try //.Headers))) + (loop [index +0 + headers //.empty] + (do {! (try.with io.monad)} + [?name (java/net/URLConnection::getHeaderFieldKey index connection)] + (case ?name + (#.Some name) + (do ! + [?value (java/net/URLConnection::getHeaderField index connection)] + (recur (inc index) + (dictionary.put name (maybe.default "" ?value) headers))) + + #.None + (wrap headers))))) + + (implementation: #export default + (Client IO) + + (def: (request method url headers data) + (: (IO (Try (//.Response IO))) + (do {! (try.with io.monad)} + [connection (|> url java/net/URL::new java/net/URL::openConnection) + #let [connection (:as java/net/HttpURLConnection connection)] + _ (java/net/HttpURLConnection::setRequestMethod (..jvm_method method) connection) + _ (monad.map ! (function (_ [name value]) + (java/net/URLConnection::setRequestProperty name value connection)) + (dictionary.entries headers)) + _ (case data + (#.Some data) + (do ! + [_ (java/net/URLConnection::setDoOutput true connection) + stream (java/net/URLConnection::getOutputStream connection) + _ (java/io/OutputStream::write data stream) + _ (java/io/OutputStream::flush stream) + _ (java/lang/AutoCloseable::close stream)] + (wrap [])) + + #.None + (wrap [])) + status (java/net/HttpURLConnection::getResponseCode connection) + headers (..default_headers connection) + input (|> connection + java/net/URLConnection::getInputStream + (\ ! map (|>> java/io/BufferedInputStream::new)))] + (wrap [(.nat status) + {#//.headers headers + #//.body (..default_body input)}]))))))] + (for {@.old (as_is <jvm>) + @.jvm (as_is <jvm>)} + (as_is))) + +(implementation: #export (async client) + (-> (Client IO) (Client Promise)) + + (def: (request method url headers data) + (|> (\ client request method url headers data) + promise.future + (\ promise.monad map + (|>> (case> (#try.Success [status message]) + (#try.Success [status (update@ #//.body (: (-> (//.Body IO) (//.Body Promise)) + (function (_ body) + (|>> body promise.future))) + message)]) + + (#try.Failure error) + (#try.Failure error))))))) + +(def: #export headers + (-> (List [Text Text]) //.Headers) + (dictionary.from_list text.hash)) diff --git a/stdlib/source/library/lux/world/net/http/cookie.lux b/stdlib/source/library/lux/world/net/http/cookie.lux new file mode 100644 index 000000000..08a75fecc --- /dev/null +++ b/stdlib/source/library/lux/world/net/http/cookie.lux @@ -0,0 +1,88 @@ +(.module: + [library + [lux #* + [control + [monad (#+ do)] + ["." try (#+ Try)] + ["p" parser ("#\." monad) + ["l" text (#+ Parser)]]] + [data + [number + ["i" int]] + [text + ["%" format (#+ format)]] + [format + ["." context (#+ Context)]] + [collection + ["." dictionary]]] + [time + ["." duration (#+ Duration)]]]] + ["." // (#+ Header) + ["." header]]) + +(type: #export Directive (-> Text Text)) + +(def: (directive extension) + (-> Text Directive) + (function (_ so-far) + (format so-far "; " extension))) + +(def: #export (set name value) + (-> Text Text Header) + (header.add "Set-Cookie" (format name "=" value))) + +(def: #export (max-age duration) + (-> Duration Directive) + (let [seconds (duration.query duration.second duration)] + (..directive (format "Max-Age=" (if (i.< +0 seconds) + (%.int seconds) + (%.nat (.nat seconds))))))) + +(template [<name> <prefix>] + [(def: #export (<name> value) + (-> Text Directive) + (..directive (format <prefix> "=" value)))] + + [domain "Domain"] + [path "Path"] + ) + +(template [<name> <tag>] + [(def: #export <name> + Directive + (..directive <tag>))] + + [secure "Secure"] + [http-only "HttpOnly"] + ) + +(type: #export CSRF-Policy + #Strict + #Lax) + +(def: #export (same-site policy) + (-> CSRF-Policy Directive) + (..directive (format "SameSite=" (case policy + #Strict "Strict" + #Lax "Lax")))) + +(def: (cookie context) + (-> Context (Parser Context)) + (do p.monad + [key (l.slice (l.many! (l.none-of! "="))) + _ (l.this "=") + value (l.slice (l.many! (l.none-of! ";")))] + (wrap (dictionary.put key value context)))) + +(def: (cookies context) + (-> Context (Parser Context)) + ($_ p.either + (do p.monad + [context' (..cookie context) + _ (l.this "; ")] + (cookies context')) + (p\wrap context))) + +(def: #export (get header) + (-> Text (Try Context)) + (l.run header (..cookies context.empty))) diff --git a/stdlib/source/library/lux/world/net/http/header.lux b/stdlib/source/library/lux/world/net/http/header.lux new file mode 100644 index 000000000..e5b1882ad --- /dev/null +++ b/stdlib/source/library/lux/world/net/http/header.lux @@ -0,0 +1,35 @@ +(.module: + [library + [lux #* + [control + [pipe (#+ case>)]] + [data + [text + ["%" format (#+ format)]] + [collection + ["." dictionary (#+ Dictionary)]]]]] + [// (#+ Header) + ["." mime (#+ MIME)] + [// (#+ URL)]]) + +(def: #export (add name value) + (-> Text Text Header) + (dictionary.upsert name "" + (|>> (case> + "" + value + + previous + (format previous "," value))))) + +(def: #export content-length + (-> Nat Header) + (|>> %.nat (..add "Content-Length"))) + +(def: #export content-type + (-> MIME Header) + (|>> mime.name (..add "Content-Type"))) + +(def: #export location + (-> URL Header) + (..add "Location")) diff --git a/stdlib/source/library/lux/world/net/http/mime.lux b/stdlib/source/library/lux/world/net/http/mime.lux new file mode 100644 index 000000000..859b0840e --- /dev/null +++ b/stdlib/source/library/lux/world/net/http/mime.lux @@ -0,0 +1,100 @@ +(.module: + [library + [lux #* + [data + ["." text + ["%" format (#+ format)] + ["." encoding (#+ Encoding)]]] + [type + abstract]]]) + +(abstract: #export MIME + Text + + {#doc "Multipurpose Internet Mail Extensions"} + + (def: #export mime + (-> Text MIME) + (|>> :abstraction)) + + (def: #export name + (-> MIME Text) + (|>> :representation)) + ) + +## https://developer.mozilla.org/en-US/docs/Web/HTTP/Basics_of_HTTP/MIME_types/Complete_list_of_MIME_types +(template [<name> <type>] + [(def: #export <name> MIME (..mime <type>))] + + [aac-audio "audio/aac"] + [abiword "application/x-abiword"] + [avi "video/x-msvideo"] + [amazon-kindle-ebook "application/vnd.amazon.ebook"] + [binary "application/octet-stream"] + [bitmap "image/bmp"] + [bzip "application/x-bzip"] + [bzip2 "application/x-bzip2"] + [c-shell "application/x-csh"] + [css "text/css"] + [csv "text/csv"] + [microsoft-word "application/msword"] + [microsoft-word-openxml "application/vnd.openxmlformats-officedocument.wordprocessingml.document"] + [ms-embedded-opentype-fonts "application/vnd.ms-fontobject"] + [epub "application/epub+zip"] + [ecmascript "application/ecmascript"] + [gif "image/gif"] + [html "text/html"] + [icon "image/x-icon"] + [icalendar "text/calendar"] + [jar "application/java-archive"] + [jpeg "image/jpeg"] + [javascript "application/javascript"] + [json "application/json"] + [midi "audio/midi"] + [mpeg "video/mpeg"] + [apple-installer-package "application/vnd.apple.installer+xml"] + [opendocument-presentation "application/vnd.oasis.opendocument.presentation"] + [opendocument-spreadsheet "application/vnd.oasis.opendocument.spreadsheet"] + [opendocument-text "application/vnd.oasis.opendocument.text"] + [ogg-audio "audio/ogg"] + [ogg-video "video/ogg"] + [ogg "application/ogg"] + [opentype-font "font/otf"] + [png "image/png"] + [pdf "application/pdf"] + [microsoft-powerpoint "application/vnd.ms-powerpoint"] + [microsoft-powerpoint-openxml "application/vnd.openxmlformats-officedocument.presentationml.presentation"] + [rar "application/x-rar-compressed"] + [rtf "application/rtf"] + [bourne-shell "application/x-sh"] + [svg "image/svg+xml"] + [flash "application/x-shockwave-flash"] + [tar "application/x-tar"] + [tiff "image/tiff"] + [typescript "application/typescript"] + [truetype-font "font/ttf"] + [microsoft-visio "application/vnd.visio"] + [wav "audio/wav"] + [webm-audio "audio/webm"] + [webm-video "video/webm"] + [webp "image/webp"] + [woff "font/woff"] + [woff2 "font/woff2"] + [xhtml "application/xhtml+xml"] + [microsoft-excel "application/vnd.ms-excel"] + [microsoft-excel-openxml "application/vnd.openxmlformats-officedocument.spreadsheetml.sheet"] + [xml "application/xml"] + [xul "application/vnd.mozilla.xul+xml"] + [zip "application/zip"] + [!3gpp-audio "audio/3gpp"] + [!3gpp "video/3gpp"] + [!3gpp2-audio "audio/3gpp2"] + [!3gpp2 "video/3gpp2"] + [!7z "application/x-7z-compressed"] + ) + +(def: #export (text encoding) + (-> Encoding MIME) + (..mime (format "text/plain; charset=" text.double-quote (encoding.name encoding) text.double-quote))) + +(def: #export utf-8 MIME (..text encoding.utf-8)) diff --git a/stdlib/source/library/lux/world/net/http/query.lux b/stdlib/source/library/lux/world/net/http/query.lux new file mode 100644 index 000000000..b6b8936b7 --- /dev/null +++ b/stdlib/source/library/lux/world/net/http/query.lux @@ -0,0 +1,65 @@ +(.module: + [library + [lux #* + [control + pipe + [monad (#+ do)] + ["." try (#+ Try)] + ["p" parser + ["l" text (#+ Parser)]]] + [data + [number + ["." nat]] + ["." text + ["%" format (#+ format)]] + [format + ["." context (#+ Context)]] + [collection + ["." dictionary]]]]]) + +(def: component + (Parser Text) + (p.rec + (function (_ component) + (do {! p.monad} + [head (l.some (l.none-of "+%&;"))] + ($_ p.either + (p.after (p.either l.end + (l.this "&")) + (wrap head)) + (do ! + [_ (l.this "+") + tail component] + (wrap (format head " " tail))) + (do ! + [_ (l.this "%") + code (|> (l.exactly 2 l.hexadecimal) + (p.codec nat.hex) + (\ ! map text.from-code)) + tail component] + (wrap (format head code tail)))))))) + +(def: (form context) + (-> Context (Parser Context)) + ($_ p.either + (do p.monad + [_ l.end] + (wrap context)) + (do {! p.monad} + [key (l.some (l.none-of "=&;")) + key (l.local key ..component)] + (p.either (do ! + [_ (l.this "=") + value ..component] + (form (dictionary.put key value context))) + (do ! + [_ ($_ p.or + (l.one-of "&;") + l.end)] + (form (dictionary.put key "" context))))) + ## if invalid form data, just stop parsing... + (\ p.monad wrap context))) + +(def: #export (parameters raw) + (-> Text (Try Context)) + (l.run raw (..form context.empty))) diff --git a/stdlib/source/library/lux/world/net/http/request.lux b/stdlib/source/library/lux/world/net/http/request.lux new file mode 100644 index 000000000..4a6911798 --- /dev/null +++ b/stdlib/source/library/lux/world/net/http/request.lux @@ -0,0 +1,128 @@ +(.module: + [library + [lux #* + [control + pipe + ["." monad (#+ do)] + ["." try (#+ Try)] + [concurrency + ["." promise (#+ Promise)] + ["." frp]] + [parser + ["<.>" json]]] + [data + ["." maybe] + ["." number + ["n" nat]] + ["." text + ["." encoding]] + [format + ["." json (#+ JSON)] + ["." context (#+ Context Property)]] + [collection + ["." list ("#\." functor fold)] + ["." dictionary]]] + [world + ["." binary (#+ Binary)]]]] + ["." // (#+ Body Response Server) + ["#." response] + ["#." query] + ["#." cookie]]) + +(def: (merge inputs) + (-> (List Binary) Binary) + (let [[_ output] (try.assume + (monad.fold try.monad + (function (_ input [offset output]) + (let [amount (binary.size input)] + (\ try.functor 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 (Try Text))) + (do promise.monad + [blobs (frp.consume body)] + (wrap (\ encoding.utf8 decode (merge blobs))))) + +(def: failure (//response.bad-request "")) + +(def: #export (json reader server) + (All [a] (-> (<json>.Reader a) (-> a Server) Server)) + (function (_ (^@ request [identification protocol resource message])) + (do promise.monad + [?raw (read-text-body (get@ #//.body message))] + (case (do try.monad + [raw ?raw + content (\ json.codec decode raw)] + (json.run content reader)) + (#try.Success input) + (server input request) + + (#try.Failure error) + (promise.resolved ..failure))))) + +(def: #export (text server) + (-> (-> Text Server) Server) + (function (_ (^@ request [identification protocol resource message])) + (do promise.monad + [?raw (read-text-body (get@ #//.body message))] + (case ?raw + (#try.Success content) + (server content request) + + (#try.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 try.monad + [query (//query.parameters query) + input (context.run query property)] + (wrap [[identification protocol (set@ #//.uri uri resource) message] + input])) + (#try.Success [request input]) + (server input request) + + (#try.Failure error) + (promise.resolved ..failure))))) + +(def: #export (form property server) + (All [a] (-> (Property a) (-> a Server) Server)) + (function (_ (^@ request [identification protocol resource message])) + (do promise.monad + [?body (read-text-body (get@ #//.body message))] + (case (do try.monad + [body ?body + form (//query.parameters body)] + (context.run form property)) + (#try.Success input) + (server input request) + + (#try.Failure error) + (promise.resolved ..failure))))) + +(def: #export (cookies property server) + (All [a] (-> (Property a) (-> a Server) Server)) + (function (_ (^@ request [identification protocol resource message])) + (case (do try.monad + [cookies (|> (get@ #//.headers message) + (dictionary.get "Cookie") + (maybe.default "") + //cookie.get)] + (context.run cookies property)) + (#try.Success input) + (server input request) + + (#try.Failure error) + (promise.resolved ..failure)))) diff --git a/stdlib/source/library/lux/world/net/http/response.lux b/stdlib/source/library/lux/world/net/http/response.lux new file mode 100644 index 000000000..0ca825a44 --- /dev/null +++ b/stdlib/source/library/lux/world/net/http/response.lux @@ -0,0 +1,74 @@ +(.module: + [library + [lux (#- static) + [control + [concurrency + ["." promise] + ["." frp ("#\." monad)]]] + [data + ["." text + ["." encoding]] + [format + ["." html] + ["." css (#+ CSS)] + ["." context] + ["." json (#+ JSON) ("#\." codec)]]] + ["." io] + [world + ["." binary (#+ Binary)]]]] + ["." // (#+ Status Body Response Server) + ["." status] + ["." mime (#+ MIME)] + ["." header] + [// (#+ URL)]]) + +(def: #export (static response) + (-> Response Server) + (function (_ request) + (promise.resolved response))) + +(def: #export empty + (-> Status Response) + (let [body (frp\wrap (\ encoding.utf8 encode ""))] + (function (_ status) + [status + {#//.headers (|> context.empty + (header.content-length 0) + (header.content-type mime.utf-8)) + #//.body body}]))) + +(def: #export (temporary-redirect to) + (-> URL Response) + (let [[status message] (..empty status.temporary-redirect)] + [status (update@ #//.headers (header.location to) message)])) + +(def: #export not-found + Response + (..empty status.not-found)) + +(def: #export (content status type data) + (-> Status MIME Binary Response) + [status + {#//.headers (|> context.empty + (header.content-length (binary.size data)) + (header.content-type type)) + #//.body (frp\wrap data)}]) + +(def: #export bad-request + (-> Text Response) + (|>> (\ encoding.utf8 encode) (content status.bad-request mime.utf-8))) + +(def: #export ok + (-> MIME Binary Response) + (content status.ok)) + +(template [<name> <type> <mime> <pre>] + [(def: #export <name> + (-> <type> Response) + (|>> <pre> (\ encoding.utf8 encode) (..ok <mime>)))] + + [text Text mime.utf-8 (<|)] + [html html.Document mime.html html.html] + [css CSS mime.css css.css] + [json JSON mime.json json\encode] + ) diff --git a/stdlib/source/library/lux/world/net/http/route.lux b/stdlib/source/library/lux/world/net/http/route.lux new file mode 100644 index 000000000..456ed9e36 --- /dev/null +++ b/stdlib/source/library/lux/world/net/http/route.lux @@ -0,0 +1,74 @@ +(.module: + [library + [lux (#- or) + [control + [monad (#+ do)] + [concurrency + ["." promise]]] + [data + ["." maybe] + ["." text] + [number + ["n" nat]]]]] + ["." // (#+ URI Server) + ["#." status] + ["#." response]]) + +(template [<scheme> <name>] + [(def: #export (<name> server) + (-> Server Server) + (function (_ (^@ request [identification protocol resource message])) + (case (get@ #//.scheme protocol) + <scheme> + (server request) + + _ + (promise.resolved //response.not-found))))] + + [#//.HTTP http] + [#//.HTTPS https] + ) + +(template [<method> <name>] + [(def: #export (<name> server) + (-> Server Server) + (function (_ (^@ request [identification protocol resource message])) + (case (get@ #//.method resource) + <method> + (server request) + + _ + (promise.resolved //response.not-found))))] + + [#//.Get get] + [#//.Post post] + [#//.Put put] + [#//.Patch patch] + [#//.Delete delete] + [#//.Head head] + [#//.Connect connect] + [#//.Options options] + [#//.Trace trace] + ) + +(def: #export (uri path server) + (-> URI Server Server) + (function (_ [identification protocol resource message]) + (if (text.starts-with? path (get@ #//.uri resource)) + (server [identification + protocol + (update@ #//.uri + (|>> (text.clip' (text.size path)) maybe.assume) + resource) + message]) + (promise.resolved //response.not-found)))) + +(def: #export (or primary alternative) + (-> Server Server Server) + (function (_ request) + (do promise.monad + [response (primary request) + #let [[status message] response]] + (if (n.= //status.not-found status) + (alternative request) + (wrap response))))) diff --git a/stdlib/source/library/lux/world/net/http/status.lux b/stdlib/source/library/lux/world/net/http/status.lux new file mode 100644 index 000000000..fe3f7d90d --- /dev/null +++ b/stdlib/source/library/lux/world/net/http/status.lux @@ -0,0 +1,83 @@ +(.module: + [library + [lux #*]] + [// (#+ Status)]) + +## https://en.wikipedia.org/wiki/List_of_HTTP_status_codes +(template [<status> <name>] + [(def: #export <name> + Status + <status>)] + + ## 1xx Informational response + [100 continue] + [101 switching_protocols] + [102 processing] + [103 early_hints] + + ## 2xx Success + [200 ok] + [201 created] + [202 accepted] + [203 non_authoritative_information] + [204 no_content] + [205 reset_content] + [206 partial_content] + [207 multi_status] + [208 already_reported] + [226 im_used] + + ## 3xx Redirection + [300 multiple_choices] + [301 moved_permanently] + [302 found] + [303 see_other] + [304 not_modified] + [305 use_proxy] + [306 switch_proxy] + [307 temporary_redirect] + [308 permanent_redirect] + + ## 4xx Client errors + [400 bad_request] + [401 unauthorized] + [402 payment_required] + [403 forbidden] + [404 not_found] + [405 method_not_allowed] + [406 not_acceptable] + [407 proxy_authentication_required] + [408 request_timeout] + [409 conflict] + [410 gone] + [411 length_required] + [412 precondition_failed] + [413 payload_too_large] + [414 uri_too_long] + [415 unsupported_media_type] + [416 range_not_satisfiable] + [417 expectation_failed] + [418 im_a_teapot] + [421 misdirected_request] + [422 unprocessable_entity] + [423 locked] + [424 failed_dependency] + [426 upgrade_required] + [428 precondition_required] + [429 too_many_requests] + [431 request_header_fields_too_large] + [451 unavailable_for_legal_reasons] + + ## 5xx Server errors + [500 internal_server_error] + [501 not_implemented] + [502 bad_gateway] + [503 service_unavailable] + [504 gateway_timeout] + [505 http_version_not_supported] + [506 variant_also_negotiates] + [507 insufficient_storage] + [508 loop_detected] + [510 not_extended] + [511 network_authentication_required] + ) diff --git a/stdlib/source/library/lux/world/net/http/version.lux b/stdlib/source/library/lux/world/net/http/version.lux new file mode 100644 index 000000000..2443fda12 --- /dev/null +++ b/stdlib/source/library/lux/world/net/http/version.lux @@ -0,0 +1,13 @@ +(.module: + [library + [lux #*]] + [// (#+ Version)]) + +(template [<name> <version>] + [(def: #export <name> Version <version>)] + + [v0_9 "0.9"] + [v1_0 "1.0"] + [v1_1 "1.1"] + [v2_0 "2.0"] + ) |