diff options
Diffstat (limited to 'stdlib/source/test/lux/world')
| -rw-r--r-- | stdlib/source/test/lux/world/binary.lux | 88 | ||||
| -rw-r--r-- | stdlib/source/test/lux/world/file.lux | 195 | ||||
| -rw-r--r-- | stdlib/source/test/lux/world/net/tcp.lux | 71 | ||||
| -rw-r--r-- | stdlib/source/test/lux/world/net/udp.lux | 64 |
4 files changed, 418 insertions, 0 deletions
diff --git a/stdlib/source/test/lux/world/binary.lux b/stdlib/source/test/lux/world/binary.lux new file mode 100644 index 000000000..ec4da0d11 --- /dev/null +++ b/stdlib/source/test/lux/world/binary.lux @@ -0,0 +1,88 @@ +(.module: + [lux #* + [control + ["." monad (#+ do)]] + [data + ["." error (#+ Error)] + ["." number + ["." i64]] + [collection + ["." list]]] + [world + ["/" binary]] + [math + ["r" random]]] + lux/test + [test + [lux + [control + ["_eq" equivalence]]]]) + +(def: (succeed result) + (-> (Error Bit) Bit) + (case result + (#error.Failure _) + #0 + + (#error.Success output) + output)) + +(def: #export (binary size) + (-> Nat (r.Random /.Binary)) + (let [output (/.create size)] + (loop [idx 0] + (if (n/< size idx) + (do r.monad + [byte r.nat] + (exec (error.assume (/.write/8 idx byte output)) + (recur (inc idx)))) + (:: r.monad wrap output))))) + +(def: (bits-io bytes read write value) + (-> Nat (-> Nat /.Binary (Error Nat)) (-> Nat Nat /.Binary (Error Any)) Nat Bit) + (let [binary (/.create 8) + bits (n/* 8 bytes) + capped-value (|> 1 (i64.left-shift bits) dec (i64.and value))] + (succeed + (do error.monad + [_ (write 0 value binary) + output (read 0 binary)] + (wrap (n/= capped-value output)))))) + +(context: "Binary." + (<| (times 100) + (do @ + [#let [gen-size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 8))))] + binary-size gen-size + random-binary (binary binary-size) + value r.nat + #let [gen-idx (|> r.nat (:: @ map (n/% binary-size)))] + [from to] (r.and gen-idx gen-idx) + #let [[from to] [(n/min from to) (n/max from to)]]] + ($_ seq + ## TODO: De-comment... + ## (_eq.spec /.equivalence (:: @ map binary gen-size)) + (test "Can get size of binary." + (|> random-binary /.size (n/= binary-size))) + (test "Can read/write 8-bit values." + (bits-io 1 /.read/8 /.write/8 value)) + (test "Can read/write 16-bit values." + (bits-io 2 /.read/16 /.write/16 value)) + (test "Can read/write 32-bit values." + (bits-io 4 /.read/32 /.write/32 value)) + (test "Can read/write 64-bit values." + (bits-io 8 /.read/64 /.write/64 value)) + (test "Can slice binaries." + (let [slice-size (|> to (n/- from) inc) + random-slice (error.assume (/.slice from to random-binary)) + idxs (list.n/range 0 (dec slice-size)) + reader (function (_ binary idx) (/.read/8 idx binary))] + (and (n/= slice-size (/.size random-slice)) + (case [(monad.map error.monad (reader random-slice) idxs) + (monad.map error.monad (|>> (n/+ from) (reader random-binary)) idxs)] + [(#error.Success slice-vals) (#error.Success binary-vals)] + (:: (list.equivalence number.nat-equivalence) = slice-vals binary-vals) + + _ + #0)))) + )))) diff --git a/stdlib/source/test/lux/world/file.lux b/stdlib/source/test/lux/world/file.lux new file mode 100644 index 000000000..b3693f207 --- /dev/null +++ b/stdlib/source/test/lux/world/file.lux @@ -0,0 +1,195 @@ +(.module: + [lux #* + ["." io (#+ IO)] + [control + [monad (#+ do)] + [security + ["." integrity (#+ Dirty)]]] + [concurrency + ["." promise]] + [data + ["." error (#+ Error)] + ["." number] + ["." text + format] + [collection + ["." list]]] + [time + ["." instant] + ["." duration]] + [world + ["@" file (#+ Path File)] + ["." binary (#+ Binary)]] + [math + ["r" random ("r/." monad)]]] + lux/test + [// + ["_." binary]]) + +(def: truncate-millis + (|>> (i// +1_000) (i/* +1_000))) + +(def: (creation-and-deletion number) + (-> Nat Test) + (r/wrap (do promise.monad + [#let [path (format "temp_file_" (%n number))] + result (promise.future + (do (error.ErrorT io.monad) + [#let [check-existence! (: (IO (Error Bit)) + (io.from-io (@.exists? io.monad @.system path)))] + pre! check-existence! + file (:: @.system create-file path) + post! check-existence! + _ (:: file delete []) + remains? check-existence!] + (wrap (and (not pre!) + post! + (not remains?)))))] + (assert "Can create/delete files." + (error.default #0 result))))) + +(def: (read-and-write number data) + (-> Nat Binary Test) + (r/wrap (do promise.monad + [#let [path (format "temp_file_" (%n number))] + result (promise.future + (do (error.ErrorT io.monad) + [file (:: @.system create-file path) + _ (:: file over-write data) + content (:: file content []) + _ (:: file delete [])] + (wrap (:: binary.equivalence = data (integrity.trust content)))))] + (assert "Can write/read files." + (error.default #0 result))))) + +(context: "File system." + (do @ + [file-size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 10)))) + dataL (_binary.binary file-size) + dataR (_binary.binary file-size) + new-modified (|> r.int (:: @ map (|>> (:: number.number abs) + truncate-millis + duration.from-millis + instant.absolute)))] + ($_ seq + (creation-and-deletion 0) + (read-and-write 1 dataL) + (wrap (do promise.monad + [#let [path "temp_file_2"] + result (promise.future + (do (error.ErrorT io.monad) + [file (:: @.system create-file path) + _ (:: file over-write dataL) + read-size (:: file size []) + _ (:: file delete [])] + (wrap (n/= file-size read-size))))] + (assert "Can read file size." + (error.default #0 result)))) + (wrap (do promise.monad + [#let [path "temp_file_3"] + result (promise.future + (do (error.ErrorT io.monad) + [file (:: @.system create-file path) + _ (:: file over-write dataL) + _ (:: file append dataR) + content (:: file content []) + read-size (:: file size []) + _ (:: file delete [])] + (wrap (and (n/= (n/* 2 file-size) read-size) + (:: binary.equivalence = + dataL + (error.assume (binary.slice 0 (dec file-size) + (integrity.trust content)))) + (:: binary.equivalence = + dataR + (error.assume (binary.slice file-size (dec read-size) + (integrity.trust content))))))))] + (assert "Can append to files." + (error.default #0 result)))) + (wrap (do promise.monad + [#let [path "temp_dir_4"] + result (promise.future + (do (error.ErrorT io.monad) + [#let [check-existence! (: (IO (Error Bit)) + (io.from-io (@.exists? io.monad @.system path)))] + pre! check-existence! + dir (:: @.system create-directory path) + post! check-existence! + _ (:: dir discard []) + 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-path "temp_file_5" + dir-path "temp_dir_5"] + result (promise.future + (do (error.ErrorT io.monad) + [dir (:: @.system create-directory dir-path) + file (:: @.system create-file (format dir-path "/" file-path)) + _ (:: file over-write dataL) + read-size (:: file size []) + _ (:: file delete []) + _ (:: dir discard [])] + (wrap (n/= file-size read-size))))] + (assert "Can create files inside of directories." + (error.default #0 result)))) + (wrap (do promise.monad + [#let [file-path "temp_file_6" + dir-path "temp_dir_6" + inner-dir-path "inner_temp_dir_6"] + result (promise.future + (do (error.ErrorT io.monad) + [dir (:: @.system create-directory dir-path) + pre-files (:: dir files []) + pre-directories (:: dir directories []) + + file (:: @.system create-file (format dir-path "/" file-path)) + inner-dir (:: @.system create-directory (format dir-path "/" inner-dir-path)) + post-files (:: dir files []) + post-directories (:: dir directories []) + + _ (:: file delete []) + _ (:: inner-dir discard []) + _ (:: dir discard [])] + (wrap (and (and (n/= 0 (list.size pre-files)) + (n/= 0 (list.size pre-directories))) + (and (n/= 1 (list.size post-files)) + (n/= 1 (list.size post-directories)))))))] + (assert "Can list files/directories inside a directory." + (error.default #0 result)))) + (wrap (do promise.monad + [#let [path "temp_file_7"] + result (promise.future + (do (error.ErrorT io.monad) + [file (:: @.system create-file path) + _ (:: file over-write dataL) + _ (:: file modify new-modified) + old-modified (:: file last-modified []) + _ (:: file delete [])] + (wrap (:: instant.equivalence = new-modified old-modified))))] + (assert "Can change the time of last modification." + (error.default #0 result)))) + (wrap (do promise.monad + [#let [path0 (format "temp_file_8+0") + path1 (format "temp_file_8+1")] + result (promise.future + (do (error.ErrorT io.monad) + [#let [check-existence! (: (-> Path (IO (Error Bit))) + (|>> (@.exists? io.monad @.system) io.from-io))] + file0 (:: @.system create-file path0) + _ (:: file0 over-write dataL) + pre! (check-existence! path0) + file1 (: (IO (Error (File IO))) ## TODO: Remove : + (:: file0 move path1)) + post! (check-existence! path0) + confirmed? (check-existence! path1) + _ (:: file1 delete [])] + (wrap (and pre! + (not post!) + confirmed?))))] + (assert "Can move a file from one path to another." + (error.default #0 result)))) + ))) diff --git a/stdlib/source/test/lux/world/net/tcp.lux b/stdlib/source/test/lux/world/net/tcp.lux new file mode 100644 index 000000000..fae5ac05d --- /dev/null +++ b/stdlib/source/test/lux/world/net/tcp.lux @@ -0,0 +1,71 @@ +(.module: + [lux #* + ["." io] + [control + [monad (#+ do)] + ["ex" exception (#+ exception:)] + [security + ["." taint]]] + [concurrency + ["." promise (#+ Promise promise)] + [frp ("frp/." functor)]] + [data + ["." error] + ["." text + format]] + [world + ["." binary] + ["." net + ["@" tcp]]] + [math + ["r" random]]] + lux/test + [/// + ["_." binary]]) + +(def: localhost net.Address "127.0.0.1") + +(def: port + (r.Random net.Port) + (|> r.nat + (:: r.monad map + (|>> (n/% 1000) + (n/+ 8000))))) + +(context: "TCP networking." + (do @ + [port ..port + size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 10)))) + from (_binary.binary size) + to (_binary.binary size)] + ($_ seq + (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." + (and from-worked? + (error.default #0 result))))) + ))) diff --git a/stdlib/source/test/lux/world/net/udp.lux b/stdlib/source/test/lux/world/net/udp.lux new file mode 100644 index 000000000..2b85958fa --- /dev/null +++ b/stdlib/source/test/lux/world/net/udp.lux @@ -0,0 +1,64 @@ +(.module: + [lux #* + [control + [monad (#+ do)] + [security + ["." integrity]]] + [concurrency + ["." promise]] + [data + ["." error] + ["." text + format]] + ["." io] + [world + ["." binary] + ["." net + ["@" udp]]] + [math + ["r" random]]] + lux/test + [/// + ["_." binary]]) + +(def: localhost net.Address "127.0.0.1") +(def: port + (r.Random net.Port) + (|> r.nat + (:: r.monad map + (|>> (n/% 1000) + (n/+ 8000))))) + +(context: "UDP networking." + (do @ + [port ..port + size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 10)))) + from (_binary.binary size) + to (_binary.binary size)] + ($_ seq + (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 (integrity.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 (integrity.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." + (error.default #0 result)))) + ))) |