aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-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
-rw-r--r--stdlib/test/test/lux/control/security/taint.lux11
-rw-r--r--stdlib/test/test/lux/world/file.lux195
-rw-r--r--stdlib/test/test/lux/world/net/tcp.lux69
-rw-r--r--stdlib/test/test/lux/world/net/udp.lux58
11 files changed, 435 insertions, 368 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)))
+ )}))
diff --git a/stdlib/test/test/lux/control/security/taint.lux b/stdlib/test/test/lux/control/security/taint.lux
index 0b18111ef..5b33e7127 100644
--- a/stdlib/test/test/lux/control/security/taint.lux
+++ b/stdlib/test/test/lux/control/security/taint.lux
@@ -6,6 +6,7 @@
[security
["@" taint]]]
[data
+ ["." error]
["." text ("text/." Equivalence<Text>)
format]]
[math
@@ -20,11 +21,15 @@
(test "Can clean a tainted value by trusting it."
(text/= raw (@.trust dirty)))
(test "Can validate a tainted value."
- (case (@.validate (|>> text.size (n/> 0)) dirty)
- (#.Some clean)
+ (case (@.validate (function (_ value)
+ (if (|> value text.size (n/> 0))
+ (#error.Success value)
+ (#error.Error "Empty text is invalid.")))
+ dirty)
+ (#error.Success clean)
(text/= raw clean)
- #.None
+ (#error.Error error)
false))
)))
diff --git a/stdlib/test/test/lux/world/file.lux b/stdlib/test/test/lux/world/file.lux
index b9bd2457a..1332ebdfc 100644
--- a/stdlib/test/test/lux/world/file.lux
+++ b/stdlib/test/test/lux/world/file.lux
@@ -1,21 +1,23 @@
(.module:
[lux #*
- [io]
+ ["." io (#+ IO)]
[control
- [monad (#+ do)]]
+ [monad (#+ do)]
+ [security
+ ["." taint (#+ Dirty)]]]
[concurrency
- [promise]]
+ ["." promise]]
[data
- [error]
- [number]
+ ["." error (#+ Error)]
+ ["." number]
["." text
format]]
[time
- [instant]
- [duration]]
+ ["." instant]
+ ["." duration]]
[world
- ["@" file]
- [binary]]
+ ["@" file (#+ File)]
+ ["." binary (#+ Binary)]]
[math
["r" random]]]
lux/test
@@ -30,114 +32,125 @@
[file-size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 10))))
dataL (_binary.binary file-size)
dataR (_binary.binary file-size)
- code r.nat
last-modified (|> r.int (:: @ map (|>> (:: number.Number<Int> abs)
truncate-millis
duration.from-millis
instant.absolute)))]
($_ seq
(wrap (do promise.Monad<Promise>
- [#let [file (format "temp_file_" (%n (n/+ 0 code)))]
+ [#let [file "temp_file_0"]
result (promise.future
- (do (:: @.JVM@System &monad)
- [pre! (@.exists? @.JVM@System file)
- _ (:: @.JVM@System write dataL file)
- post! (@.exists? @.JVM@System file)
- _ (:: @.JVM@System delete file)
- remains? (@.exists? @.JVM@System file)]
- (wrap (and (not pre!) post!
+ (do io.Monad<Process>
+ [#let [check-existence! (: (IO (Error Bit))
+ (@.exists? io.Monad<IO> @.System<IO> file))]
+ pre! check-existence!
+ _ (:: @.System<IO> write dataL file)
+ post! check-existence!
+ _ (:: @.System<IO> delete file)
+ remains? check-existence!]
+ (wrap (and (not pre!)
+ post!
(not remains?)))))]
(assert "Can create/delete files."
(error.default #0 result))))
(wrap (do promise.Monad<Promise>
- [#let [file (format "temp_file_" (%n (n/+ 1 code)))]
+ [#let [file "temp_file_1"]
result (promise.future
- (do (:: @.JVM@System &monad)
- [_ (:: @.JVM@System write dataL file)
- output (:: @.JVM@System read file)
- _ (:: @.JVM@System delete file)]
- (wrap (:: binary.Equivalence<Binary> = dataL output))))]
+ (do io.Monad<Process>
+ [_ (:: @.System<IO> write dataL file)
+ output (:: @.System<IO> read file)
+ _ (:: @.System<IO> delete file)]
+ (wrap (:: binary.Equivalence<Binary> = dataL (taint.trust output)))))]
(assert "Can write/read files."
(error.default #0 result))))
(wrap (do promise.Monad<Promise>
- [#let [file (format "temp_file_" (%n (n/+ 2 code)))]
+ [#let [file "temp_file_2"]
result (promise.future
- (do (:: @.JVM@System &monad)
- [_ (:: @.JVM@System write dataL file)
- read-size (:: @.JVM@System size file)
- _ (:: @.JVM@System delete file)]
+ (do io.Monad<Process>
+ [_ (:: @.System<IO> write dataL file)
+ read-size (:: @.System<IO> size file)
+ _ (:: @.System<IO> delete file)]
(wrap (n/= file-size read-size))))]
(assert "Can read file size."
(error.default #0 result))))
(wrap (do promise.Monad<Promise>
- [#let [file (format "temp_file_" (%n (n/+ 3 code)))]
+ [#let [file "temp_file_3"]
result (promise.future
- (do (:: @.JVM@System &monad)
- [_ (:: @.JVM@System write dataL file)
- _ (:: @.JVM@System append dataR file)
- output (:: @.JVM@System read file)
- read-size (:: @.JVM@System size file)
- _ (:: @.JVM@System delete file)]
+ (do io.Monad<Process>
+ [_ (:: @.System<IO> write dataL file)
+ _ (:: @.System<IO> append dataR file)
+ output (:: @.System<IO> read file)
+ read-size (:: @.System<IO> size file)
+ _ (:: @.System<IO> delete file)]
(wrap (and (n/= (n/* 2 file-size) read-size)
- (:: binary.Equivalence<Binary> = dataL (error.assume (binary.slice 0 (dec file-size) output)))
- (:: binary.Equivalence<Binary> = dataR (error.assume (binary.slice file-size (dec read-size) output)))))))]
+ (:: binary.Equivalence<Binary> =
+ dataL
+ (error.assume (binary.slice 0 (dec file-size)
+ (taint.trust output))))
+ (:: binary.Equivalence<Binary> =
+ dataR
+ (error.assume (binary.slice file-size (dec read-size)
+ (taint.trust output))))))))]
(assert "Can append to files."
(error.default #0 result))))
(wrap (do promise.Monad<Promise>
- [#let [dir (format "temp_dir_" (%n (n/+ 4 code)))]
+ [#let [dir "temp_dir_4"]
result (promise.future
- (do (:: @.JVM@System &monad)
- [pre! (@.exists? @.JVM@System dir)
- _ (:: @.JVM@System make-directory dir)
- post! (@.exists? @.JVM@System dir)
- _ (:: @.JVM@System delete dir)
- remains? (@.exists? @.JVM@System dir)]
- (wrap (and (not pre!) post!
+ (do io.Monad<Process>
+ [#let [check-existence! (: (IO (Error Bit))
+ (@.exists? io.Monad<IO> @.System<IO> dir))]
+ pre! check-existence!
+ _ (:: @.System<IO> make-directory dir)
+ post! check-existence!
+ _ (:: @.System<IO> delete dir)
+ remains? check-existence!]
+ (wrap (and (not pre!)
+ post!
(not remains?)))))]
(assert "Can create/delete directories."
(error.default #0 result))))
(wrap (do promise.Monad<Promise>
- [#let [file (format "temp_file_" (%n (n/+ 5 code)))
- dir (format "temp_dir_" (%n (n/+ 5 code)))]
+ [#let [file "temp_file_5"
+ dir "temp_dir_5"]
result (promise.future
- (do (:: @.JVM@System &monad)
- [_ (:: @.JVM@System write dataL file)
- file-is-file (:: @.JVM@System file? file)
- file-is-directory (:: @.JVM@System directory? file)
- _ (:: @.JVM@System delete file)
- _ (:: @.JVM@System make-directory dir)
- directory-is-file (:: @.JVM@System file? dir)
- directory-is-directory (:: @.JVM@System directory? dir)
- _ (:: @.JVM@System delete dir)]
+ (do io.Monad<Process>
+ [_ (:: @.System<IO> write dataL file)
+ file-is-file (:: @.System<IO> file? file)
+ file-is-directory (:: @.System<IO> directory? file)
+ _ (:: @.System<IO> delete file)
+ _ (:: @.System<IO> make-directory dir)
+ directory-is-file (:: @.System<IO> file? dir)
+ directory-is-directory (:: @.System<IO> directory? dir)
+ _ (:: @.System<IO> delete dir)]
(wrap (and file-is-file (not file-is-directory)
(not directory-is-file) directory-is-directory))))]
(assert "Can differentiate files from directories."
(error.default #0 result))))
(wrap (do promise.Monad<Promise>
- [#let [file (format "temp_file_" (%n (n/+ 6 code)))
- dir (format "temp_dir_" (%n (n/+ 6 code)))]
+ [#let [file "temp_file_6"
+ dir "temp_dir_6"]
result (promise.future
- (do (:: @.JVM@System &monad)
- [_ (:: @.JVM@System make-directory dir)
+ (do io.Monad<Process>
+ [_ (:: @.System<IO> make-directory dir)
#let [file' (format dir "/" file)]
- _ (:: @.JVM@System write dataL file')
- read-size (:: @.JVM@System size file')
- _ (:: @.JVM@System delete file')
- _ (:: @.JVM@System delete dir)]
+ _ (:: @.System<IO> write dataL file')
+ read-size (:: @.System<IO> size file')
+ _ (:: @.System<IO> delete file')
+ _ (:: @.System<IO> delete dir)]
(wrap (n/= file-size read-size))))]
(assert "Can create files inside of directories."
(error.default #0 result))))
(wrap (do promise.Monad<Promise>
- [#let [file (format "temp_file_" (%n (n/+ 7 code)))
- dir (format "temp_dir_" (%n (n/+ 7 code)))]
+ [#let [file "temp_file_7"
+ dir "temp_dir_7"]
result (promise.future
- (do (:: @.JVM@System &monad)
- [_ (:: @.JVM@System make-directory dir)
+ (do io.Monad<Process>
+ [_ (:: @.System<IO> make-directory dir)
#let [file' (format dir "/" file)]
- _ (:: @.JVM@System write dataL file')
- children (:: @.JVM@System files dir)
- _ (:: @.JVM@System delete file')
- _ (:: @.JVM@System delete dir)]
+ _ (:: @.System<IO> write dataL file')
+ children (:: @.System<IO> files dir)
+ _ (:: @.System<IO> delete file')
+ _ (:: @.System<IO> delete dir)]
(wrap (case children
(^ (list child))
(text.ends-with? file' child)
@@ -147,28 +160,32 @@
(assert "Can list files inside a directory."
(error.default #0 result))))
(wrap (do promise.Monad<Promise>
- [#let [file (format "temp_file_" (%n (n/+ 8 code)))]
+ [#let [file "temp_file_8"]
result (promise.future
- (do (:: @.JVM@System &monad)
- [_ (:: @.JVM@System write dataL file)
- _ (:: @.JVM@System modify last-modified file)
- time-read (:: @.JVM@System last-modified file)
- _ (:: @.JVM@System delete file)]
+ (do io.Monad<Process>
+ [_ (:: @.System<IO> write dataL file)
+ _ (:: @.System<IO> modify last-modified file)
+ time-read (:: @.System<IO> last-modified file)
+ _ (:: @.System<IO> delete file)]
(wrap (:: instant.Equivalence<Instant> = last-modified time-read))))]
(assert "Can change the time of last modification."
(error.default #0 result))))
(wrap (do promise.Monad<Promise>
- [#let [file0 (format "temp_file_" (%n (n/+ 9 code)) "+0")
- file1 (format "temp_file_" (%n (n/+ 9 code)) "+1")]
+ [#let [file0 (format "temp_file_9+0")
+ file1 (format "temp_file_9+1")]
result (promise.future
- (do (:: @.JVM@System &monad)
- [_ (:: @.JVM@System write dataL file0)
- pre! (@.exists? @.JVM@System file0)
- _ (:: @.JVM@System move file1 file0)
- post! (@.exists? @.JVM@System file0)
- confirmed? (@.exists? @.JVM@System file1)
- _ (:: @.JVM@System delete file1)]
- (wrap (and pre! (not post!) confirmed?))))]
+ (do io.Monad<Process>
+ [#let [check-existence! (: (-> File (IO (Error Bit)))
+ (@.exists? io.Monad<IO> @.System<IO>))]
+ _ (:: @.System<IO> write dataL file0)
+ pre! (check-existence! file0)
+ _ (:: @.System<IO> move file1 file0)
+ post! (check-existence! file0)
+ confirmed? (check-existence! file1)
+ _ (:: @.System<IO> delete file1)]
+ (wrap (and pre!
+ (not post!)
+ confirmed?))))]
(assert "Can move a file from one path to another."
(error.default #0 result))))
)))
diff --git a/stdlib/test/test/lux/world/net/tcp.lux b/stdlib/test/test/lux/world/net/tcp.lux
index 7520a2fbc..ecae405d7 100644
--- a/stdlib/test/test/lux/world/net/tcp.lux
+++ b/stdlib/test/test/lux/world/net/tcp.lux
@@ -3,13 +3,14 @@
["." io]
[control
[monad (#+ do)]
- ["ex" exception (#+ exception:)]]
+ ["ex" exception (#+ exception:)]
+ [security
+ ["." taint]]]
[concurrency
- ["P" promise]
- ["T" task]
+ ["." promise (#+ Promise promise)]
[frp ("frp/." Functor<Channel>)]]
[data
- ["E" error]
+ ["." error]
["." text
format]]
[world
@@ -23,6 +24,7 @@
["_." binary]])
(def: localhost net.Address "127.0.0.1")
+
(def: port
(r.Random net.Port)
(|> r.nat
@@ -35,36 +37,35 @@
[port ..port
size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 10))))
from (_binary.binary size)
- to (_binary.binary size)
- #let [temp-from (binary.create size)
- temp-to (binary.create size)]]
+ to (_binary.binary size)]
($_ seq
- (wrap (do P.Monad<Promise>
- [result (do T.Monad<Task>
- [[server-close server] (@.server port)
- #let [from-worked? (: (T.Task Bit)
- (P.promise #.Nil))
- _ (frp/map (function (_ socket)
- (do @
- [bytes-from (@.read temp-from 0 size socket)
- #let [_ (io.run (P.resolve (#E.Success (and (n/= size bytes-from)
- (:: binary.Equivalence<Binary> = from temp-from)))
- from-worked?))]]
- (@.write to 0 size socket)))
- server)]
-
- client (@.client localhost port)
- _ (@.write from 0 size client)
- from-worked? from-worked?
- ####################
- bytes-to (@.read temp-to 0 size client)
- #let [to-worked? (and (n/= size bytes-to)
- (:: binary.Equivalence<Binary> = to temp-to))]
- ####################
- _ (@.close client)
- _ (T.from-promise (P.future (P.resolve [] server-close)))]
- (wrap (and from-worked?
- to-worked?)))]
+ (wrap (do promise.Monad<Promise>
+ [#let [from-worked? (: (Promise Bit)
+ (promise #.Nil))]
+ result (promise.future
+ (do io.Monad<Process>
+ [[server-close server] (@.server port)
+ #let [_ (frp/map (function (_ client)
+ (promise.future
+ (do @
+ [[trasmission-size transmission] (:: client read size)
+ #let [_ (io.run (promise.resolve (and (n/= size trasmission-size)
+ (:: binary.Equivalence<Binary> = from (taint.trust transmission)))
+ from-worked?))]]
+ (:: client write to))))
+ server)]
+ client (@.client localhost port)
+ _ (:: client write from)
+ ####################
+ [trasmission-size transmission] (:: client read size)
+ #let [to-worked? (and (n/= size trasmission-size)
+ (:: binary.Equivalence<Binary> = to (taint.trust transmission)))]
+ ####################
+ _ (:: client close [])
+ _ (io.from-io (promise.resolve [] server-close))]
+ (wrap to-worked?)))
+ from-worked? from-worked?]
(assert "Can communicate between client and server."
- (E.default #0 result))))
+ (and from-worked?
+ (error.default #0 result)))))
)))
diff --git a/stdlib/test/test/lux/world/net/udp.lux b/stdlib/test/test/lux/world/net/udp.lux
index 497cef8f3..d630816d8 100644
--- a/stdlib/test/test/lux/world/net/udp.lux
+++ b/stdlib/test/test/lux/world/net/udp.lux
@@ -1,14 +1,16 @@
(.module:
[lux #*
[control
- [monad (#+ do)]]
+ [monad (#+ do)]
+ [security
+ ["." taint]]]
[concurrency
- ["P" promise]
- ["T" task]]
+ ["." promise]]
[data
- ["E" error]
+ ["." error]
["." text
format]]
+ ["." io]
[world
["." binary]
["." net
@@ -32,29 +34,31 @@
[port ..port
size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 10))))
from (_binary.binary size)
- to (_binary.binary size)
- #let [temp (binary.create size)]]
+ to (_binary.binary size)]
($_ seq
- (wrap (do P.Monad<Promise>
- [result (do T.Monad<Task>
- [server (@.server port)
- client (@.client [])
- ####################
- _ (@.write localhost port from 0 size client)
- [bytes-from from-address from-port] (@.read temp 0 size server)
- #let [from-worked? (and (n/= size bytes-from)
- (:: binary.Equivalence<Binary> = from temp))]
- ####################
- _ (@.write from-address from-port to 0 size server)
- [bytes-to to-address to-port] (@.read temp 0 size client)
- #let [to-worked? (and (n/= size bytes-to)
- (:: binary.Equivalence<Binary> = to temp)
- (n/= port to-port))]
- ####################
- _ (@.close client)
- _ (@.close server)]
- (wrap (and from-worked?
- to-worked?)))]
+ (wrap (do promise.Monad<Promise>
+ [result (promise.future
+ (do io.Monad<Process>
+ [server (@.server port)
+ client @.client
+ ####################
+ _ (:: client write [localhost port] from)
+ [bytes-from [from-address from-port] temp] (:: server read size)
+ #let [from-worked? (and (n/= size bytes-from)
+ (:: binary.Equivalence<Binary> = from (taint.trust temp)))]
+ ####################
+ _ (:: server write [from-address from-port] to)
+ [bytes-to [to-address to-port] temp] (:: client read size)
+ #let [to-worked? (and (n/= size bytes-to)
+ (:: binary.Equivalence<Binary> = to (taint.trust temp))
+ (n/= port to-port))]
+ ####################
+ _ (:: client close [])
+ _ (:: server close [])]
+ ## (wrap false)
+ (wrap (and from-worked?
+ to-worked?))
+ ))]
(assert "Can communicate between client and server."
- (E.default #0 result))))
+ (error.default #0 result))))
)))
generated by cgit v1.2.3 (git 2.25.1) at 2024-08-25 11:53:27 +0000