aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/control/security/taint.lux12
-rw-r--r--stdlib/source/lux/world/console.lux40
-rw-r--r--stdlib/source/lux/world/environment.jvm.lux11
-rw-r--r--stdlib/source/lux/world/file.lux81
-rw-r--r--stdlib/source/lux/world/net.lux5
-rw-r--r--stdlib/source/lux/world/net/tcp.jvm.lux175
-rw-r--r--stdlib/source/lux/world/net/udp.jvm.lux146
7 files changed, 255 insertions, 215 deletions
diff --git a/stdlib/source/lux/control/security/taint.lux b/stdlib/source/lux/control/security/taint.lux
index 745baa95f..afdc1904c 100644
--- a/stdlib/source/lux/control/security/taint.lux
+++ b/stdlib/source/lux/control/security/taint.lux
@@ -1,10 +1,11 @@
(.module:
[lux #*
[control
- [predicate (#+ Predicate)]
[functor (#+ Functor)]
[apply (#+ Apply)]
[monad (#+ Monad)]]
+ [data
+ [error (#+ Error)]]
[type
abstract]])
@@ -15,12 +16,9 @@
(All [a] (-> a (Dirty a)))
(|>> :abstraction))
- (def: #export (validate valid? dirty)
- (All [a] (-> (Predicate a) (Dirty a) (Maybe a)))
- (let [value (:representation dirty)]
- (if (valid? value)
- (#.Some value)
- #.None)))
+ (def: #export (validate validator dirty)
+ (All [a b] (-> (-> a (Error b)) (Dirty a) (Error b)))
+ (validator (:representation dirty)))
(def: #export trust
(All [a] (-> (Dirty a) a))
diff --git a/stdlib/source/lux/world/console.lux b/stdlib/source/lux/world/console.lux
index cf7d2f2d4..99d290479 100644
--- a/stdlib/source/lux/world/console.lux
+++ b/stdlib/source/lux/world/console.lux
@@ -2,15 +2,20 @@
[lux #*
[control
[monad (#+ do)]
- ["ex" exception (#+ exception:)]]
+ ["ex" exception (#+ exception:)]
+ [security
+ ["." taint (#+ Dirty taint)]]]
[data
- ["." error]
+ ["." error (#+ Error)]
["." text
format]]
["." io (#+ IO Process io)]
+ [concurrency
+ ["." promise (#+ Promise)]]
[host (#+ import:)]
- [compiler
- ["." host]]])
+ [platform
+ [compiler
+ ["." host]]]])
(do-template [<name>]
[(exception: #export (<name>)
@@ -21,15 +26,22 @@
)
(signature: #export (Console !)
- (: (-> [] (! Nat))
+ (: (-> Any (! (Error (Dirty Nat))))
read)
- (: (-> [] (! Text))
+ (: (-> Any (! (Error (Dirty Text))))
read-line)
- (: (-> Text (! Any))
+ (: (-> Text (! (Error Any)))
write)
- (: (-> [] (! Any))
+ (: (-> Any (! (Error Any)))
close))
+(def: #export (async console)
+ (-> (Console IO) (Console Promise))
+ (`` (structure (~~ (do-template [<capability>]
+ [(def: <capability> (|>> (:: console <capability>) promise.future))]
+
+ [read] [read-line] [write] [close])))))
+
(`` (for {(~~ (static host.jvm))
(as-is (import: java/lang/String)
@@ -47,8 +59,8 @@
(#static in java/io/InputStream)
(#static out java/io/PrintStream))
- (def: #export open
- (Process (Console Process))
+ (def: #export system
+ (IO (Error (Console IO)))
(do io.Monad<IO>
[?jvm-console (System::console)]
(case ?jvm-console
@@ -60,15 +72,17 @@
jvm-output (System::out)]
(<| io.from-io
wrap
- (: (Console Process)) ## TODO: Remove ASAP
+ (: (Console IO)) ## TODO: Remove ASAP
(structure
(def: (read _)
(|> jvm-input
InputStream::read
- (:: io.Functor<Process> map .nat)))
+ (:: io.Functor<Process> map (|>> .nat taint))))
(def: (read-line _)
- (java/io/Console::readLine jvm-console))
+ (|> jvm-console
+ java/io/Console::readLine
+ (:: io.Functor<Process> map taint)))
(def: (write message)
(PrintStream::print message jvm-output))
diff --git a/stdlib/source/lux/world/environment.jvm.lux b/stdlib/source/lux/world/environment.jvm.lux
index 2a64c31f8..57ffcd465 100644
--- a/stdlib/source/lux/world/environment.jvm.lux
+++ b/stdlib/source/lux/world/environment.jvm.lux
@@ -1,5 +1,8 @@
(.module:
[lux #*
+ [control
+ [security
+ ["." taint (#+ Dirty taint)]]]
[data
["." text]
[format
@@ -9,6 +12,9 @@
[io (#- run)]
[host (#+ import:)]])
+## Do not trust the values of environment variables
+## https://wiki.sei.cmu.edu/confluence/display/java/ENV02-J.+Do+not+trust+the+values+of+environment+variables
+
(import: java/lang/String)
(import: (java/util/Map$Entry k v)
@@ -41,9 +47,10 @@
(Map$Entry::getValue entry)])
(def: #export read
- (IO Context)
+ (IO (Dirty Context))
(io (|> (System::getenv)
Map::entrySet
Set::iterator
(consume-iterator entry-to-kv)
- (dictionary.from-list text.Hash<Text>))))
+ (dictionary.from-list text.Hash<Text>)
+ taint)))
diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux
index e97668917..9b53e4453 100644
--- a/stdlib/source/lux/world/file.lux
+++ b/stdlib/source/lux/world/file.lux
@@ -2,7 +2,9 @@
[lux #*
[control
["." monad (#+ Monad do)]
- ["ex" exception (#+ Exception exception:)]]
+ ["ex" exception (#+ Exception exception:)]
+ [security
+ ["." taint (#+ Dirty taint)]]]
[data
["." maybe]
["." error (#+ Error)]
@@ -15,10 +17,13 @@
["." duration]]
[world
["." binary (#+ Binary)]]
- ["." io (#+ Process)]
+ ["." io (#+ IO)]
+ [concurrency
+ ["." promise (#+ Promise)]]
[host (#+ import:)]
- [compiler
- ["." host]]])
+ [platform
+ [compiler
+ ["." host]]]])
(type: #export File Text)
@@ -28,63 +33,70 @@
#Execute)
(signature: #export (System !)
- (: (Monad !)
- &monad)
-
- (: (All [e a] (-> (Exception e) e (! a)))
- throw)
-
- (: (All [a] (-> (! a) (! (Error a))))
- try)
-
- (: (All [a] (-> (Error a) (! a)))
- lift)
-
(do-template [<name>]
- [(: (-> Binary File (! Any))
+ [(: (-> Binary File (! (Error Any)))
<name>)]
[append]
[write])
(do-template [<name> <output>]
- [(: (-> File (! <output>))
+ [(: (-> File (! (Error <output>)))
<name>)]
- [read Binary]
+ [read (Dirty Binary)]
[size Nat]
[files (List File)]
[last-modified Instant])
(do-template [<name>]
- [(: (-> File (! Bit))
+ [(: (-> File (! (Error Bit)))
<name>)]
[file?]
[directory?]
)
- (: (-> Permission File (! Bit))
+ (: (-> Permission File (! (Error Bit)))
can?)
(do-template [<name>]
- [(: (-> File (! Any))
+ [(: (-> File (! (Error Any)))
<name>)]
[make-directory]
[delete]
)
- (: (-> File File (! Any))
+ (: (-> File File (! (Error Any)))
move)
- (: (-> Instant File (! Any))
+ (: (-> Instant File (! (Error Any)))
modify)
(: Text
separator)
)
+(def: #export (async system)
+ (-> (System IO) (System Promise))
+ (`` (structure
+ (~~ (do-template [<name>]
+ [(def: (<name> parameter file)
+ (promise.future (:: system <name> parameter file)))]
+
+ [append] [write]
+ [can?] [move] [modify]))
+
+ (~~ (do-template [<name>]
+ [(def: <name> (|>> (:: system <name>) promise.future))]
+
+ [read] [size] [files] [last-modified]
+ [file?] [directory?]
+ [make-directory] [delete]))
+
+ (def: separator (:: system separator)))))
+
(def: #export (un-nest System<!> file)
(All [!] (-> (System !) File (Maybe [File Text])))
(case (text.last-index-of (:: System<!> separator) file)
@@ -152,18 +164,7 @@
(import: java/io/FileInputStream
(new [java/io/File] #io #try))
- (structure: #export JVM@System (System Process)
- (def: &monad io.Monad<Process>)
-
- (def: throw io.throw)
-
- (def: (try computation)
- (do io.Monad<IO>
- [outcome computation]
- (:: io.Monad<Process> wrap outcome)))
-
- (def: lift (:: io.Monad<IO> wrap))
-
+ (structure: #export _ (System IO)
(do-template [<name> <flag>]
[(def: (<name> data file)
(do io.Monad<Process>
@@ -185,7 +186,7 @@
bytes-read (InputStream::read data stream)
_ (AutoCloseable::close stream)]
(if (i/= size bytes-read)
- (wrap data)
+ (wrap (taint data))
(io.io (ex.throw cannot-read-all-data file)))))
(def: size
@@ -258,9 +259,9 @@
))
}))
-(def: #export (exists? System<!> file)
- (All [!] (-> (System !) File (! Bit)))
- (do (:: System<!> &monad)
+(def: #export (exists? Monad<!> System<!> file)
+ (All [!] (-> (Monad !) (System !) File (! (Error Bit))))
+ (do (error.ErrorT Monad<!>)
[??? (:: System<!> file? file)]
(if ???
(wrap ???)
diff --git a/stdlib/source/lux/world/net.lux b/stdlib/source/lux/world/net.lux
index c7e597a66..867430af0 100644
--- a/stdlib/source/lux/world/net.lux
+++ b/stdlib/source/lux/world/net.lux
@@ -2,4 +2,9 @@
lux)
(type: #export Address Text)
+
(type: #export Port Nat)
+
+(type: #export Location
+ {#address Address
+ #port Port})
diff --git a/stdlib/source/lux/world/net/tcp.jvm.lux b/stdlib/source/lux/world/net/tcp.jvm.lux
index 50191c407..329d256e0 100644
--- a/stdlib/source/lux/world/net/tcp.jvm.lux
+++ b/stdlib/source/lux/world/net/tcp.jvm.lux
@@ -1,19 +1,22 @@
(.module:
[lux #*
[control
- monad]
+ monad
+ [security
+ ["." taint (#+ Dirty taint)]]]
[concurrency
["." promise (#+ Promise promise)]
[task (#+ Task)]
["." frp]]
[data
- ["e" error]]
- [type
- abstract]
+ ["." error (#+ Error)]]
[world
- [binary (#+ Binary)]]
- ["." io (#+ Process)]
- [host (#+ import:)]]
+ ["." binary (#+ Binary)]]
+ ["." io (#+ IO)]
+ [host (#+ import:)]
+ [platform
+ [compiler
+ ["." host]]]]
["." //])
(import: java/lang/AutoCloseable
@@ -30,8 +33,8 @@
(import: java/net/Socket
(new [String int] #io #try)
- (getInputStream [] #io #try InputStream)
- (getOutputStream [] #io #try OutputStream))
+ (getInputStream [] #try InputStream)
+ (getOutputStream [] #try OutputStream))
(import: java/net/ServerSocket
(new [int] #io #try)
@@ -41,80 +44,80 @@
############################################################
############################################################
-(abstract: #export TCP {}
- {#socket Socket
- #in InputStream
- #out OutputStream}
-
- (def: #export (read data offset length self)
- (-> Binary Nat Nat TCP (Task Nat))
- (promise.future
- (do io.Monad<Process>
- [bytes-read (InputStream::read data (.int offset) (.int length)
- (get@ #in (:representation self)))]
- (wrap (.nat bytes-read)))))
-
- (def: #export (write data offset length self)
- (-> Binary Nat Nat TCP (Task Any))
- (let [out (get@ #out (:representation self))]
- (promise.future
- (do io.Monad<Process>
- [_ (OutputStream::write data (.int offset) (.int length)
- out)]
- (Flushable::flush out)))))
-
- (def: #export (close self)
- (-> TCP (Task Any))
- (let [(^open ".") (:representation self)]
- (promise.future
- (do io.Monad<Process>
- [_ (AutoCloseable::close in)
- _ (AutoCloseable::close out)]
- (AutoCloseable::close socket)))))
-
- (def: (tcp-client socket)
- (-> Socket (Process TCP))
- (do io.Monad<Process>
- [input (Socket::getInputStream socket)
- output (Socket::getOutputStream socket)]
- (wrap (:abstraction {#socket socket
- #in input
- #out output}))))
- )
-
-(def: #export (client address port)
- (-> //.Address //.Port (Task TCP))
- (promise.future
- (do io.Monad<Process>
- [socket (Socket::new address (.int port))]
- (tcp-client socket))))
-
-(def: #export (server port)
- (-> //.Port (Task [(Promise Any)
- (frp.Channel TCP)]))
- (promise.future
- (do (e.ErrorT io.Monad<IO>)
- [server (ServerSocket::new (.int port))
- #let [signal (: (Promise Any)
- (promise #.None))
- _ (promise.await (function (_ _)
- (AutoCloseable::close server))
- signal)
- output (: (frp.Channel TCP)
- (frp.channel []))
- _ (: (Promise Any)
- (promise.future
- (loop [_ []]
- (do io.Monad<IO>
- [?client (do (e.ErrorT io.Monad<IO>)
- [socket (ServerSocket::accept server)]
- (tcp-client socket))]
- (case ?client
- (#e.Error error)
- (wrap [])
-
- (#e.Success client)
- (do @
- [_ (frp.publish output client)]
- (recur [])))))))]]
- (wrap [signal output]))))
+(signature: #export (TCP !)
+ (: (-> Nat (! (Error [Nat (Dirty Binary)])))
+ read)
+
+ (: (-> Binary (! (Error Any)))
+ write)
+
+ (: (-> Any (! (Error Any)))
+ close))
+
+(def: #export (async tcp)
+ (-> (TCP IO) (TCP Promise))
+ (`` (structure (~~ (do-template [<capability>]
+ [(def: <capability> (|>> (:: tcp <capability>) promise.future))]
+
+ [read] [write] [close])))))
+
+(`` (for {(~~ (static host.jvm))
+ (as-is (def: (tcp socket)
+ (-> Socket (Error (TCP IO)))
+ (do error.Monad<Error>
+ [input (Socket::getInputStream socket)
+ output (Socket::getOutputStream socket)]
+ (wrap (: (TCP IO)
+ (structure (def: (read size)
+ (do io.Monad<Process>
+ [#let [data (binary.create size)]
+ bytes-read (InputStream::read data +0 (.int size) input)]
+ (wrap [(.nat bytes-read)
+ (taint data)])))
+
+ (def: (write data)
+ (do io.Monad<Process>
+ [_ (OutputStream::write data +0 (.int (binary.size data))
+ output)]
+ (Flushable::flush output)))
+
+ (def: (close _)
+ (do io.Monad<Process>
+ [_ (AutoCloseable::close input)
+ _ (AutoCloseable::close output)]
+ (AutoCloseable::close socket))))))))
+
+ (def: #export (client address port)
+ (-> //.Address //.Port (IO (Error (TCP IO))))
+ (do io.Monad<Process>
+ [socket (Socket::new address (.int port))]
+ (io.io (tcp socket))))
+
+ (def: #export (server port)
+ (-> //.Port (IO (Error [(Promise Any)
+ (frp.Channel (TCP IO))])))
+ (do io.Monad<Process>
+ [server (ServerSocket::new (.int port))
+ #let [close-signal (: (Promise Any)
+ (promise #.None))
+ _ (promise.await (function (_ _)
+ (AutoCloseable::close server))
+ close-signal)
+ output (: (frp.Channel (TCP IO))
+ (frp.channel []))
+ _ (: (Promise Any)
+ (promise.future
+ (loop [_ []]
+ (do io.Monad<IO>
+ [?client (do io.Monad<Process>
+ [socket (ServerSocket::accept server)]
+ (io.io (tcp socket)))]
+ (case ?client
+ (#error.Error error)
+ (wrap [])
+
+ (#error.Success client)
+ (do @
+ [_ (frp.publish output client)]
+ (recur [])))))))]]
+ (wrap [close-signal output]))))}))
diff --git a/stdlib/source/lux/world/net/udp.jvm.lux b/stdlib/source/lux/world/net/udp.jvm.lux
index 8b785eb98..842f1c969 100644
--- a/stdlib/source/lux/world/net/udp.jvm.lux
+++ b/stdlib/source/lux/world/net/udp.jvm.lux
@@ -2,22 +2,25 @@
[lux #*
[control
monad
- ["ex" exception (#+ exception:)]]
+ ["ex" exception (#+ exception:)]
+ [security
+ ["." taint (#+ Dirty taint)]]]
[concurrency
- ["P" promise]
- ["T" task]]
+ ["." promise (#+ Promise)]
+ [task (#+ Task)]]
[data
- ["e" error]
+ ["." error (#+ Error)]
["." maybe]
[collection
["." array]]]
- [type
- abstract]
[world
- [binary (#+ Binary)]]
- ["." io]
- [host (#+ import:)]]
- ["." //])
+ ["." binary (#+ Binary)]]
+ ["." io (#+ IO)]
+ [host (#+ import:)]
+ [platform
+ [compiler
+ ["." host]]]]
+ ["." // (#+ Location)])
(import: java/lang/AutoCloseable
(close [] #io #try void))
@@ -47,62 +50,71 @@
############################################################
(exception: #export (cannot-resolve-address {address //.Address})
- address)
+ (ex.report ["Address" address]))
(exception: #export (multiple-candidate-addresses {address //.Address})
- address)
-
-(def: (resolve address)
- (-> //.Address (io.IO (e.Error InetAddress)))
- (do (e.ErrorT io.Monad<IO>)
- [addresses (InetAddress::getAllByName address)]
- (: (io.IO (e.Error InetAddress))
- (case (array.size addresses)
- 0 (io.io (ex.throw cannot-resolve-address address))
- 1 (wrap (maybe.assume (array.read 0 addresses)))
- _ (io.io (ex.throw multiple-candidate-addresses address))))))
-
-(abstract: #export UDP {}
- {#socket DatagramSocket}
-
- (def: #export (read data offset length self)
- (-> Binary Nat Nat UDP (T.Task [Nat //.Address //.Port]))
- (let [(^open ".") (:representation self)
- packet (DatagramPacket::new|receive data (.int offset) (.int length))]
- (P.future
- (do (e.ErrorT io.Monad<IO>)
- [_ (DatagramSocket::receive packet socket)
- #let [bytes-read (.nat (DatagramPacket::getLength packet))]]
- (wrap [bytes-read
- (|> packet DatagramPacket::getAddress InetAddress::getHostAddress)
- (.nat (DatagramPacket::getPort packet))])))))
-
- (def: #export (write address port data offset length self)
- (-> //.Address //.Port Binary Nat Nat UDP (T.Task Any))
- (P.future
- (do (e.ErrorT io.Monad<IO>)
- [address (resolve address)
- #let [(^open ".") (:representation self)]]
- (DatagramSocket::send (DatagramPacket::new|send data (.int offset) (.int length) address (.int port))
- socket))))
-
- (def: #export (close self)
- (-> UDP (T.Task Any))
- (let [(^open ".") (:representation self)]
- (P.future
- (AutoCloseable::close socket))))
-
- (def: #export (client _)
- (-> Any (T.Task UDP))
- (P.future
- (do (e.ErrorT io.Monad<IO>)
- [socket (DatagramSocket::new|client)]
- (wrap (:abstraction (#socket socket))))))
-
- (def: #export (server port)
- (-> //.Port (T.Task UDP))
- (P.future
- (do (e.ErrorT io.Monad<IO>)
- [socket (DatagramSocket::new|server (.int port))]
- (wrap (:abstraction (#socket socket))))))
- )
+ (ex.report ["Address" address]))
+
+(signature: #export (UDP !)
+ (: (-> Nat (! (Error [Nat Location (Dirty Binary)])))
+ read)
+
+ (: (-> Location Binary (! (Error Any)))
+ write)
+
+ (: (-> Any (! (Error Any)))
+ close))
+
+(def: #export (async udp)
+ (-> (UDP IO) (UDP Promise))
+ (`` (structure (def: read (|>> (:: udp read) promise.future))
+
+ (def: (write location data)
+ (promise.future (:: udp write location data)))
+
+ (def: close (|>> (:: udp close) promise.future)))))
+
+(`` (for {(~~ (static host.jvm))
+ (as-is (def: (resolve address)
+ (-> //.Address (IO (Error InetAddress)))
+ (do io.Monad<Process>
+ [addresses (InetAddress::getAllByName address)]
+ (: (IO (Error InetAddress))
+ (case (array.size addresses)
+ 0 (io.io (ex.throw cannot-resolve-address address))
+ 1 (wrap (maybe.assume (array.read 0 addresses)))
+ _ (io.io (ex.throw multiple-candidate-addresses address))))))
+
+ (def: (udp socket)
+ (-> DatagramSocket (UDP IO))
+ (structure (def: (read size)
+ (let [data (binary.create size)
+ packet (DatagramPacket::new|receive data +0 (.int size))]
+ (do io.Monad<Process>
+ [_ (DatagramSocket::receive packet socket)
+ #let [bytes-read (.nat (DatagramPacket::getLength packet))]]
+ (wrap [bytes-read
+ {#//.address (|> packet DatagramPacket::getAddress InetAddress::getHostAddress)
+ #//.port (.nat (DatagramPacket::getPort packet))}
+ (taint data)]))))
+
+ (def: (write location data)
+ (do io.Monad<Process>
+ [address (resolve (get@ #//.address location))]
+ (DatagramSocket::send (DatagramPacket::new|send data +0 (.int (binary.size data)) address (.int (get@ #//.port location)))
+ socket)))
+
+ (def: (close _)
+ (AutoCloseable::close socket))))
+
+ (def: #export client
+ (IO (Error (UDP IO)))
+ (|> (DatagramSocket::new|client)
+ (:: io.Monad<Process> map udp)))
+
+ (def: #export server
+ (-> //.Port (IO (Error (UDP IO))))
+ (|>> .int
+ DatagramSocket::new|server
+ (:: io.Monad<Process> map udp)))
+ )}))
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-06 18:35:59 +0000