From 970e950aeb08179972d9e3460af3003771fc8511 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Mon, 4 Sep 2017 19:42:38 -0400
Subject: - Implemented network I/O for TCP and UDP (in the JVM).

---
 stdlib/test/test/lux/world/net/tcp.lux | 70 ++++++++++++++++++++++++++++++++++
 stdlib/test/test/lux/world/net/udp.lux | 70 ++++++++++++++++++++++++++++++++++
 stdlib/test/tests.lux                  |  4 +-
 3 files changed, 143 insertions(+), 1 deletion(-)
 create mode 100644 stdlib/test/test/lux/world/net/tcp.lux
 create mode 100644 stdlib/test/test/lux/world/net/udp.lux

(limited to 'stdlib/test')

diff --git a/stdlib/test/test/lux/world/net/tcp.lux b/stdlib/test/test/lux/world/net/tcp.lux
new file mode 100644
index 000000000..4c975b4dd
--- /dev/null
+++ b/stdlib/test/test/lux/world/net/tcp.lux
@@ -0,0 +1,70 @@
+(;module:
+  lux
+  (lux [io]
+       (control [monad #+ do]
+                ["ex" exception #+ exception:])
+       (concurrency ["P" promise]
+                    ["T" task]
+                    [frp])
+       (data ["R" result]
+             [text]
+             text/format)
+       (world [blob]
+              [net]
+              (net ["@" tcp]))
+       ["r" math/random])
+  lux/test
+  (../.. ["_;" blob]))
+
+(def: localhost net;Address "127.0.0.1")
+(def: port
+  (r;Random net;Port)
+  (|> r;nat
+      (:: r;Monad<Random> map
+          (|>. (n.% +1000)
+               (n.+ +8000)))))
+
+(exception: Empty-Channel)
+
+(def: (head channel)
+  (All [a] (-> (frp;Channel a) (T;Task a)))
+  (do P;Monad<Promise>
+    [head+tail channel]
+    (case head+tail
+      (#;Some [head tail])
+      (wrap (ex;return head))
+
+      #;None
+      (wrap (ex;throw Empty-Channel "")))))
+
+(context: "TCP networking."
+  #times +1
+  [port ;;port
+   size (|> r;nat (:: @ map (|>. (n.% +100) (n.max +10))))
+   from (_blob;blob size)
+   to (_blob;blob size)
+   #let [temp (blob;create size)]]
+  ($_ seq
+      (do P;Monad<Promise>
+        [result (do T;Monad<Task>
+                  [server (@;server port)
+                   client (@;client localhost port)
+                   ####################
+                   _ (@;write from +0 size client)
+                   socket (head server)
+                   bytes-from (@;read temp +0 size socket)
+                   #let [from-worked? (and (n.= size bytes-from)
+                                           (:: blob;Eq<Blob> = from temp))]
+                   ####################
+                   _ (@;write to +0 size socket)
+                   bytes-to (@;read temp +0 size client)
+                   #let [to-worked? (and (n.= size bytes-to)
+                                         (:: blob;Eq<Blob> = to temp))]
+                   ####################
+                   _ (@;close client)
+                   _ (T;from-promise (P;future (frp;close server)))]
+                  (wrap (and from-worked?
+                             to-worked?)))]
+        (test "Can communicate between client and server."
+              (R;default false result)))
+      ))
diff --git a/stdlib/test/test/lux/world/net/udp.lux b/stdlib/test/test/lux/world/net/udp.lux
new file mode 100644
index 000000000..8af67bcd5
--- /dev/null
+++ b/stdlib/test/test/lux/world/net/udp.lux
@@ -0,0 +1,70 @@
+(;module:
+  lux
+  (lux [io]
+       (control [monad #+ do]
+                ["ex" exception #+ exception:])
+       (concurrency ["P" promise]
+                    ["T" task]
+                    [frp])
+       (data ["R" result]
+             [text]
+             text/format)
+       (world [blob]
+              [net]
+              (net ["@" udp]))
+       ["r" math/random])
+  lux/test
+  (../.. ["_;" blob]))
+
+(def: localhost net;Address "127.0.0.1")
+(def: port
+  (r;Random net;Port)
+  (|> r;nat
+      (:: r;Monad<Random> map
+          (|>. (n.% +1000)
+               (n.+ +8000)))))
+
+(exception: Empty-Channel)
+
+(def: (head channel)
+  (All [a] (-> (frp;Channel a) (T;Task a)))
+  (do P;Monad<Promise>
+    [head+tail channel]
+    (case head+tail
+      (#;Some [head tail])
+      (wrap (ex;return head))
+
+      #;None
+      (wrap (ex;throw Empty-Channel "")))))
+
+(context: "UDP networking."
+  #times +1
+  [port ;;port
+   size (|> r;nat (:: @ map (|>. (n.% +100) (n.max +10))))
+   from (_blob;blob size)
+   to (_blob;blob size)
+   #let [temp (blob;create size)]]
+  ($_ seq
+      (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)
+                                           (:: blob;Eq<Blob> = 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)
+                                         (:: blob;Eq<Blob> = to temp)
+                                         (n.= port to-port))]
+                   ####################
+                   _ (@;close client)
+                   _ (@;close server)]
+                  (wrap (and from-worked?
+                             to-worked?)))]
+        (test "Can communicate between client and server."
+              (R;default false result)))
+      ))
diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux
index ee503c94c..fffe409c4 100644
--- a/stdlib/test/tests.lux
+++ b/stdlib/test/tests.lux
@@ -71,7 +71,9 @@
                    ["_;" auto]
                    ["_;" object])
              (world ["_;" blob]
-                    ["_;" fs])
+                    ["_;" fs]
+                    (net ["_;" tcp]
+                         ["_;" udp]))
              ))
   (lux (control [contract]
                 [concatenative])
-- 
cgit v1.2.3