From 789b163fd54d80d08d15cef4d48357a638a00f24 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 5 Dec 2018 21:59:56 -0400 Subject: Now tainting values coming from the outside world. --- stdlib/source/lux/control/security/taint.lux | 12 +- stdlib/source/lux/world/console.lux | 40 +++-- stdlib/source/lux/world/environment.jvm.lux | 11 +- stdlib/source/lux/world/file.lux | 81 +++++----- stdlib/source/lux/world/net.lux | 5 + stdlib/source/lux/world/net/tcp.jvm.lux | 175 ++++++++++----------- stdlib/source/lux/world/net/udp.jvm.lux | 146 ++++++++++-------- stdlib/test/test/lux/control/security/taint.lux | 11 +- stdlib/test/test/lux/world/file.lux | 195 +++++++++++++----------- stdlib/test/test/lux/world/net/tcp.lux | 69 ++++----- stdlib/test/test/lux/world/net/udp.lux | 58 +++---- 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 [] [(exception: #export () @@ -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 [] + [(def: (|>> (:: console ) 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 [?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 map .nat))) + (:: io.Functor map (|>> .nat taint)))) (def: (read-line _) - (java/io/Console::readLine jvm-console)) + (|> jvm-console + java/io/Console::readLine + (:: io.Functor 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)))) + (dictionary.from-list text.Hash) + 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 [] - [(: (-> Binary File (! Any)) + [(: (-> Binary File (! (Error Any))) )] [append] [write]) (do-template [ ] - [(: (-> File (! )) + [(: (-> File (! (Error ))) )] - [read Binary] + [read (Dirty Binary)] [size Nat] [files (List File)] [last-modified Instant]) (do-template [] - [(: (-> File (! Bit)) + [(: (-> File (! (Error Bit))) )] [file?] [directory?] ) - (: (-> Permission File (! Bit)) + (: (-> Permission File (! (Error Bit))) can?) (do-template [] - [(: (-> File (! Any)) + [(: (-> File (! (Error Any))) )] [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 [] + [(def: ( parameter file) + (promise.future (:: system parameter file)))] + + [append] [write] + [can?] [move] [modify])) + + (~~ (do-template [] + [(def: (|>> (:: system ) 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) - - (def: throw io.throw) - - (def: (try computation) - (do io.Monad - [outcome computation] - (:: io.Monad wrap outcome))) - - (def: lift (:: io.Monad wrap)) - + (structure: #export _ (System IO) (do-template [ ] [(def: ( data file) (do io.Monad @@ -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 - [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 - [_ (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 - [_ (AutoCloseable::close in) - _ (AutoCloseable::close out)] - (AutoCloseable::close socket))))) - - (def: (tcp-client socket) - (-> Socket (Process TCP)) - (do io.Monad - [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 - [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) - [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 - [?client (do (e.ErrorT io.Monad) - [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 [] + [(def: (|>> (:: tcp ) promise.future))] + + [read] [write] [close]))))) + +(`` (for {(~~ (static host.jvm)) + (as-is (def: (tcp socket) + (-> Socket (Error (TCP IO))) + (do error.Monad + [input (Socket::getInputStream socket) + output (Socket::getOutputStream socket)] + (wrap (: (TCP IO) + (structure (def: (read size) + (do io.Monad + [#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 + [_ (OutputStream::write data +0 (.int (binary.size data)) + output)] + (Flushable::flush output))) + + (def: (close _) + (do io.Monad + [_ (AutoCloseable::close input) + _ (AutoCloseable::close output)] + (AutoCloseable::close socket)))))))) + + (def: #export (client address port) + (-> //.Address //.Port (IO (Error (TCP IO)))) + (do io.Monad + [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 + [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 + [?client (do io.Monad + [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) - [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) - [_ (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) - [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) - [socket (DatagramSocket::new|client)] - (wrap (:abstraction (#socket socket)))))) - - (def: #export (server port) - (-> //.Port (T.Task UDP)) - (P.future - (do (e.ErrorT io.Monad) - [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 + [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 + [_ (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 + [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 map udp))) + + (def: #export server + (-> //.Port (IO (Error (UDP IO)))) + (|>> .int + DatagramSocket::new|server + (:: io.Monad 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) 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 abs) truncate-millis duration.from-millis instant.absolute)))] ($_ seq (wrap (do promise.Monad - [#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 + [#let [check-existence! (: (IO (Error Bit)) + (@.exists? io.Monad @.System file))] + pre! check-existence! + _ (:: @.System write dataL file) + post! check-existence! + _ (:: @.System 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 - [#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 = dataL output))))] + (do io.Monad + [_ (:: @.System write dataL file) + output (:: @.System read file) + _ (:: @.System delete file)] + (wrap (:: binary.Equivalence = dataL (taint.trust output)))))] (assert "Can write/read files." (error.default #0 result)))) (wrap (do promise.Monad - [#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 + [_ (:: @.System write dataL file) + read-size (:: @.System size file) + _ (:: @.System delete file)] (wrap (n/= file-size read-size))))] (assert "Can read file size." (error.default #0 result)))) (wrap (do promise.Monad - [#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 + [_ (:: @.System write dataL file) + _ (:: @.System append dataR file) + output (:: @.System read file) + read-size (:: @.System size file) + _ (:: @.System delete file)] (wrap (and (n/= (n/* 2 file-size) read-size) - (:: binary.Equivalence = dataL (error.assume (binary.slice 0 (dec file-size) output))) - (:: binary.Equivalence = dataR (error.assume (binary.slice file-size (dec read-size) output)))))))] + (:: binary.Equivalence = + dataL + (error.assume (binary.slice 0 (dec file-size) + (taint.trust output)))) + (:: binary.Equivalence = + 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 - [#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 + [#let [check-existence! (: (IO (Error Bit)) + (@.exists? io.Monad @.System dir))] + pre! check-existence! + _ (:: @.System make-directory dir) + post! check-existence! + _ (:: @.System 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 - [#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 + [_ (:: @.System write dataL file) + file-is-file (:: @.System file? file) + file-is-directory (:: @.System directory? file) + _ (:: @.System delete file) + _ (:: @.System make-directory dir) + directory-is-file (:: @.System file? dir) + directory-is-directory (:: @.System directory? dir) + _ (:: @.System 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 - [#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 + [_ (:: @.System 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 write dataL file') + read-size (:: @.System size file') + _ (:: @.System delete file') + _ (:: @.System delete dir)] (wrap (n/= file-size read-size))))] (assert "Can create files inside of directories." (error.default #0 result)))) (wrap (do promise.Monad - [#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 + [_ (:: @.System 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 write dataL file') + children (:: @.System files dir) + _ (:: @.System delete file') + _ (:: @.System 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 - [#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 + [_ (:: @.System write dataL file) + _ (:: @.System modify last-modified file) + time-read (:: @.System last-modified file) + _ (:: @.System delete file)] (wrap (:: instant.Equivalence = last-modified time-read))))] (assert "Can change the time of last modification." (error.default #0 result)))) (wrap (do promise.Monad - [#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 + [#let [check-existence! (: (-> File (IO (Error Bit))) + (@.exists? io.Monad @.System))] + _ (:: @.System write dataL file0) + pre! (check-existence! file0) + _ (:: @.System move file1 file0) + post! (check-existence! file0) + confirmed? (check-existence! file1) + _ (:: @.System 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)]] [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 - [result (do T.Monad - [[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 = 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 = to temp-to))] - #################### - _ (@.close client) - _ (T.from-promise (P.future (P.resolve [] server-close)))] - (wrap (and from-worked? - to-worked?)))] + (wrap (do promise.Monad + [#let [from-worked? (: (Promise Bit) + (promise #.Nil))] + result (promise.future + (do io.Monad + [[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 = 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 = 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 - [result (do T.Monad - [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 = 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 = to temp) - (n/= port to-port))] - #################### - _ (@.close client) - _ (@.close server)] - (wrap (and from-worked? - to-worked?)))] + (wrap (do promise.Monad + [result (promise.future + (do io.Monad + [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 = 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 = 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)))) ))) -- cgit v1.2.3